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ABSTRACT 


Edmonson,  William  M.,  M.S.,  Department  of  Computer  Science, 
Wright  State  University,  1983.  FORJR:  An  Implementation  of 
BAD  JR  Using  FORTH  and  Z80  Assembly  Language. 


The  FORJR  project  implements  a  system  to  provide  an 
interactive  BADJR  functional  programming  machine.  The 
interactive  programming  language,  FORTH,  is  combined  with 
Z80  assembly  language  modules  and  can  be  run  on  Z80-based 
systems  under  the  CP/M  Operating  System.  A  frame-stack 
mechanism  implements  the  attribute  grammer  of  BADJR.  The 
assembly  language  portion  of  FORJR  was  developed 
independently  of  this  project,  but  is  modified  to  provide  an 
interface  with  FORTH.  The  FORTH  environment  set  up  calls  to 
the  specific  assembly  language  modules  which  manipulate 
attribute  storage  areas.  Upon  completion  of  specified 
tasks,  execution  control  is  returned  to  FORTH.  Special 
attention  is  directed  at  storage  management  of  FORJR, 
including  details  of  attribute  passing,  garbage  collection 
and  compaction. 

Examples  of  FORJR  programs  are  provided  including 
explanations  and  illustrations  of  simple  and  recursive  FORJR 
calls. 
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INTRODUCTION 


1.0  PRIMARY  OBJECTIVES 

The  primary  objective  of  the  FORJR  project  was  to 
implement  an  interactive  BADJR  functional  programming 
machine  using  FORTH  and  Z80  assembly  language  modules. 
BADJR  is  a  functional  language  currently  under  research  and 
development  by  Computer  Science  Department  faculty  and 
students  of  the  FLITE  Project  at  Wright  State  University, 
Dayton,  Ohio.  The  functional  specifications  for  the  FORJR 
machine  are  based  upon  the  BADJR  Report  [DIX083  ]. 

FORJR,  as  the  name  implies,  combined  the  interactive 


f  ac  il  i  t  ie  s 

of 

FORTH 

with  a 

BADJR 

functional  language 

machine  . 

The 

BADJR 

m  ac  hin  e 

used 

in  this  project  was 

developed  independently  in  Richard  Franklin's  "ZBADJR:  An 

Implementation  of  the  BADJR  Machine  in  Z80  Assembly 
Language"  [FRAN833*  Certain  modules  of  the  ZBADJR  code  were 
modified  to  permit  smooth  transitions  to  and  from  the  FORTH 
environment.  An  assembly  language  interface  was  developed 
to  protect  the  FORTH  environment  and  to  set  up  the 
appropriate  calls  to  ZBADJR  routines. 
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FORJR  is  designed  to  run  on  any  Z80-based  system  using 
the  CP/M  Operating  System.  The  emphasis  the  project  places 
on  the  interactive  facilities  of  FORJR  coincides  with  the 
increasing  interest  in  using  FORTH  as  a  teaching  tool  at 
Wright  State.  Students  already  knowledgeable  in  FORTH 
should  adapt  readily  to  experimenting  with  functional 
programming  in  FORJR. 

Examples  of  FORJR  programming  have  beer  provided, 
ranging  from  simple,  single-line  entries  tc  complex, 
recursive  routines.  However,  as  with  other  -  .-ractive 
systems,  hands-on  experimentation  with  FORJR  proved  to  be 
the  best  research  method. 

Data  object  representation  in  FORJR  closely  resembles 
the  structure  used  by  Sloan  [SLOA83  3.  The  advantage  FORJR 
has  over  other  implementations  is  that  the  storage  areas 
used  to  hold  data  objects  can  be  examined  periodically 
between  FORJR  function  calls.  This  feature  permits  the  user 
to  see  direct  results  on  the  data  objects  and  storage  areas 
between  FORJR  function  calls. 

Section  II  describes  the  FORJR  machine  environment, 
and  the  linking  convention  of  the  FORTH  and  ZBADJR  files. 

Section  III  describes  the  FORJR  attribute  and  data 
object  representation.  In  addition,  storage  management 
procedures  are  discussed  including  garbage  collection  and 
storage  compaction. 


Section  IV  details  the  syntax  of  FORJR  instructions 
Examples  of  simple  FORJR  functions  calls  are  included 
Section  V  concludes  the  FORJR  Project  discussion  an 
includes  recommendations  for  future  research. 
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II.  F  OR  JR  MACHINE  ENVIRONMENT 


1.0  INTRODUCTION 

The  ZBADJR  system  designed  by  Franklin  provides  a  good 
system  for  studying  functional  programming.  For  the  most 
part,  ZBADJR  models  the  BADJR  machine  as  discussed  in  the 
original  BADJR  report.  However,  ZBADJR  has  a  major 
limitation  in  that  all  ZBADJR  user  programs  must  be  written, 
compiled,  and  linked  in  Z80  assembly  language.  This  task 
does  not  lend  itself  to  experimentation  because  of  the  time 
consumming  task  of  writing  test  programs  even  for  simple 
tests.  FOR  JR  circumvents  this  problem  by  combining  the 
power  of  the  ZBADJR  assembly  language  modules  with  the  ease 
of  use  of  FORTH  interactive  programming. 


2.  FORTH  AND  Z  BAD  JR  INTERFACE 


The  ZBADJR  source  programs  made  extensive  use  of  macro 
calls.  The  original  system  consisted  of  over  80  separate 
macros  that  resembled  BADJR  functions.  The  majority  of 
these  macros  contained  multiple  instructions  including 
additional  macro  calls.  These  macros  manipulated  the  ZBADJR 
data  storage  areas  by  calls  to  specific  Z  80  assembly 
language  routines.  The  basic  design  of  FOR  JR  was  to 
establish  an  interface  between  FORTH  and  ZBADJR  and  devise 
methods  to  emulate  the  macro  calls. 

2.1  INTERFACING  FORTH  WITH  ZBADJR 

FORTH,  through  the  use  of  assembly  language 
instructions,  has  mechanisms  by  which  other  programs  can  be 
called,  but  the  called  programs  must  be  in  memory  along  with 
the  FORTH  system.  A  Z80  assembly  language  program  was 
devised  to  act  as  an  interface  between  FORTH  and  ZBADJR. 
This  program  has  two  functions.  The  first  is  to  preserve 
the  FORTH  registers  and  return  address  to  ensure  a  smooth 
transition  from  FORTH  to  ZBADJR  and  back  to  FORTH.  The 
second  function  of  the  interface  program  involves  using  a 
jump  table  to  invoke  specific  ZBADJR  modules.  The  jump 
table  will  be  discussed  in  the  next  section. 

Because  the  ZBADJR  programs  and  FORTH  system  must 
reside  in  memory  together,  special  linking  and  loading 
conventions  were  needed  to  create  a  single  executeable 
module.  The  Z80  interface  program  and  ZBADJR  modules  are 


linked  and  loaded  at  location  9100H 


Figure  1  shows  the 


memory  configuration  of  the  FORJR  system 
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FIGURE  1.  FORJR  Memory  Configuration 

The  interface  program  provides  the  single  entry  point 
to  the  ZBADJR  routines.  When  FORTH  calls  the  interface 
program,  location  9100H,  the  return  address  to  FORTH  is 
pushed  onto  the  system  stack.  The  interface  program 
preserves  the  FORTH  interpreter  pointer  ( BC  register)  and 
the  return  pointer  (IY  register)  in  separate  memory 
locations.  The  appropriate  ZBADJR  routine  is  then  called 
via  the  jump  table.  After  the  ZBADJR  routine  executes, 
control  returns  to  the  interface  program  which  restores  the 
FORTH  registers,  pushes  the  FORTH  return  address  onto  the 
system  stack  and  executes  a  return  to  FORTH. 

2.2  ZBADJR  JUMP  TABLE 

A  jump  table  was  created  containing  entries  for  each 
ZBADJR  function.  The  jump  table  can  be  found  in  the  first 


program  of  the  Z-80  Source  listings,  Appendix  C 


All 


entries  are  3-byte  Z80  JUMP  commands.  Not  all  ZBADJR 
functions  are  currently  installed  in  FORJR,  so  3-byte 
entries  were  provided  as  place  holders  to  permit  future 
implementation.  All  valid  entries  in  the  jump  table  have  a 
corresponding  FORJR  command.  When  a  FORJR  command  is 
invoked,  a  value  is  placed  onto  the  FORTH  parameter  stack. 
This  value  is  then  multiplied  by  three  to  provide  a  3-byte 
offset  into  the  jump  table.  FORTH  then  calls  the  interface 
routine.  Since  all  ZBADJR  routines  execute  a  RETURN  when 
complete,  the  interface  routine  pushes  a  return  address  onto 
the  system  stack  prior  to  jumping  to  any  ZBADJR  routine. 
The  interface  routine  then  calculates  the  offset  into  the 
jump  table  where  the  appropriate  ZBADJR  routine  is  invoked. 

Some  FORJR  routines  need  to  pass  parameters  to  the 
ZBADJR  routines.  The  FORTH  parameter  stack,  which  is  the 
same  stack  as  the  Z-80  system  stack,  is  used  for  this 
purpose.  The  necessary  parameters  are  pushed  onto  the  FORTH 
stack  prior  to  pushing  the  jump  table  index  and  calling  the 
interface  program.  Any  ZBADJR  routine  that  returns 
parameters  to  FORTH  reverses  this  process  by  pushing 
appropriate  values  onto  the  system  stack  prior  to  returning 
to  the  interface  program. 


III.  FOR  JR  DATA  REPRESENTATION 

1.0  ATTRIBUTES 

The  BADJR  report  defines  data  objects  as  attributes  and 
describes  three  types:  INHERITED,  SYNTHESIZED,  and  LOCAL. 

BADJR  uses  these  attributes  to  pass  values  between  BADJR 
routines.  All  inherited  attributes  are  defined,  i  .e . 
assigned  a  type  and  value  prior  to  entry  into  a  BADJR 
routine.  Synthesized  attributes  are  defined  by  BADJR 
routines  and  once  defined  may  not  be  modified  again.  BADJR 
routines  may  also  use  local  attributes  that  are  defined  and 
used  only  during  that  routine's  execution. 

F  OR  JR  attributes  are  represented  by  2-byte  hex  numbers 
that  are  indices  into  a  list  of  node  descriptor  blocks.  As 
attributes  are  created,  they  are  given  a  unique  index  value 
which  is  assigned  in  increasing  order  from  1  to  N,  where  N 
is  the  maximum  number  of  nodes  permitted.  FORJR  currently 

has  provisions  for  256  nodes.  Synthesized  attributes  are 

given  an  index  without  further  defining  the  attribute  type 

or  value.  When  a  FORJR  routine  is  to  define  the  synthesized 

attribute,  the  index  of  that  attribute  is  passed  to  that 
FORJR  routine  along  with  relevant  inherited  attributes.  The 
FORJR  routine  then  assigns  a  type  and  value  to  the 


synthesized  attribute 


When  a  synthesized  attribute  is  defined,  an  address  in 
the  attribute’s  node  description  block  is  set  to  point  to 
the  location  of  an  associated  stringspace  which  contains  the 
type  and  value  of  the  attribute.  More  detailed  explanations 
of  the  nodelist  and  stringspace  areas  can  be  found  in 
paragraph  2,  STORAGE  MANAGEMENT. 

1.1  ATTRIBUTE  PASSING  MECHANISM 

FORJR  uses  a  stack-oriented  mechanism  to  pass 
attributes  to  other  FORJR  routines.  Each  routine  operates 
on  a  ’frame’  that  contains  attribute  indices  that  the 
routine  will  use  or  define.  All  inherited  attributes  come 
from  the  pvevious  frame.  To  rerieve  atributes  from  the 
previous  frame,  the  user  must  'stack*  the  desired  attributes 
onto  the  current  frame.  This  is  accomplished  via  the  STKINH 
command.  E.G.  if  you  want  the  third  attribute  from  the 
previous  frame,  enter: 

3  STKINH 

Frames  are  stacked  in  a  data  structure  called  the 
INHERITANCE  STACK.  FORJR  uses  attributes  from  the  top  most 
frame  for  all  data  manipulation.  Therefore,  before  calling 
the  FORJR  routine,  the  current  frame  must  contain  all 
relavent  attributes  and  in  the  order  expected  by  the 
particular  FORJR  routine. 

2.0  STORAGE  MANAGEMENT 

The  BADJR  Report  described  the  properties  of  BADJR 
objects.  FORJR  follows  the  BADJR  conventions  except  for  one 
significant  difference:  numbers  may  be  represented  as  fixed- 


1  0 


point  decimals  as  well  as  integers. 

2.  1  OBJECTS  IN  MEMORY 

The  Z-80  assembly  language  portion  of  FORJR  contains 
the  data  storage  areas  used  to  hold  frames  and  objects.  The 
primary  areas  are  the  INHERITANCE  STACK,  NODELIST,  and 
STRINGSPACE. 

2.  0.  1  INHERITANCE  STACK 

Initially,  the  inheritance  stack,  sometimes  called  the 
frame  stack,  is  set  to  zeros.  As  frames  are  created,  a 
pointer  to  the  floor  of  the  old  frame  (OBAS  or  old-base- 
at  tr  ibut  e-stac  k)  is  stored  in  the  first  word  of  the  new 
frame  which  is  the  floor  of  the  new  frame  (or  BAS).  The 
floor  of  the  first  frame  contains  the  address  of  the 
inheritance  stack  ("ground")  indicating  it  is  the  bottom 
frame  on  the  stack.  Figure  2  shows  the  inheritance  stack 
with  an  initial  frame  containing  the  indicies  of  three 
attributes.  (Note:  The  beginning  address  of  the  inheritance 
stack  in  Figure  2  is  98D0H.) 
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FIGURE  2 


Inheritance  Stack  With  One  Frame 
(2b  -  >  2  bytes  ) 


Figure  3  shows  the  inheritance  stack  with  an  additional 
frame  stacked  using  two  attributes  from  the  first  frame  and 
two  new  attributes. 
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FIGURE  3.  Inheritance  Stack  With  Two  Frames 


2.0.2  NODELIST 

The  attribute  indices  mentioned  above  are  unique  2-byte 
indices  into  the  nodelist.  These  attribute  indices  are 
allocated  sequentially.  The  nodelist  containing  the 
attribute  indices  consists  of  4-byte  nodes.  The  first  two 
bytes  is  an  address  field  pointing  to  a  stringspace 
representing  a  corresponding  attribute.  The  third  byte  is  a 
tag  field  and  the  forth  byte  is  unused.  The  use  of  the 
address  field  is  discussed  below.  An  explanation  of  the  tag 
field  is  in  paragraph  2. 3,  GARBAGE  COLLECTION  AND  STORAGE 
COMPACTION.  Initially,  all  nodes  are  set  to  "avail", 


indicated  by  FFFFH.  Figure  4.  depicts  the  initial  nodelist. 
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FIGURE  4.  Initial  NodeList 


In  the  event  a  synthesized  attribute  is  allocated,  but 
not  yet  defined,  the  address  field  is  marked  as  "taken", 
i  .e .  set  to  0.  When  an  immediate  attribute  is  created  or  a 
synthesized  attribute  defined  and  allocated  storage  space, 
the  storage  manager  is  called  to  get  a  pointer  to  free 
storage  in  the  stringspace.  The  pointer  that  is  returned  is 
stored  in  the  address  field  of  the  associated  node  in  the 
nodelist.  Simultaneously,  the  node  index  is  stored  in  the 
index  area  of  the  stringspace.  Figure  5.  shows  the  nodelist 
with  the  three  attributes  contained  in  the  inheritance  stack 
shown  in  Figure  2. 
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2.0.3  STRINGSPACE 

Data  objects  are  stored  as  strings  in  the  stringspace. 
Each  string  that  represents  a  data  object  has  a  5-byte 
header.  The  first  two  bytes  contain  the  index  (IDX)  back  to 
the  corresponding  node  in  the  nodelist.  The  third  byte 
contains  the  type  (TYP)  of  attribute  the  string  represents. 
Attribute  types  are  discussed  in  paragraph  2.2,  below.  The 
last  two  bytes  of  the  header  contains  a  2-byte  relative 
displacement  (NXT)  to  the  next  node  in  stringspace.  NXT 
represents  the  number  of  bytes  from  IDX  of  the  current 
string  to  IDX  of  the  next  string  or  free  storage.  Figure  6 
represents  how  storage  appears  with  two  attributes,  a  symbol 
representing  "  ABC"  (See  Figure  6a),  and  a  numeric 
attribute,  if  123  (Figure  6b.) 
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FIGURE  6a.  First  Attribute:  "  ABC". 
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FIGURE  6b 


Second  Attribute:  0  123 


In  Figure  6b,  WHL  specifies  that  two  bytes  of  packed  BCD 
data  are  to  be  considered  as  whole  numbers.  In  this 
example,  the  first  byte  is  01  and  the  second  byte  is  23* 
Together,  these  bytes  comprise  the  number  +123.  A  full 
explanation  of  the  string  representation  of  a  number  follows 
in  par  ag  raph  2.2.1. 

2.2  DATA  TYPES 

Data  typing  of  FORJR  objects  corresponds  to  types  of 
data  described  in  the  BADJR  Report  with  the  exception  of 
STREAMS.  At  the  present  time,  STREAM  processing  is  not 
implemented  in  FORJR.  The  following  shows  the  types  of  data 
represented  in  FORJR. 

OBJECT  TYPE  (HEX) 

NEC.  NUMBER  Cl 

POS.  NUMBER  C  2 

SYMBOL  DO 

BOOLEAN  DO 

SEQUENCE  E0 

2.2.1  NUMBERS  (Type  Cl  or  C2) 

In  FORJR  numbers,  the  type  field  indicates  the  sign  of 
the  number,  type  Cl  for  negative  numbers,  type  C2  for 
positive  numbers.  FORJR  stores  decimal  digits  in  packed  BCD 
format  with  two  decimal  digits  per  byte.  FORJR  arithmetic 
is  accomplished  in  decimal.  Figure  6b  showed  a  numeric 
string,  #  123.  with  two  additional  fields,  WHL  (for  WHOLE 
NUMBER),  and  FRC  (for  FRACTION.)  These  fields  indicate  the 


number  of  packed  BCD  bytes  to  the  left  and  right, 
respectively,  of  the  implied  decimal  point.  Therefore,  the 
first  whole  byte  of  the  number  may  have  a  leading  zero  digit 
to  align  the  bytes  properly.  Since  WHL  and  FRC  are  1-byte 
hex  numbers,  FORJR  can  represent  at  most  256  decimal  digits 
to  the  right  of  the  decimal  point  and  256  digits  to  the  left 
of  the  decimal  decimal  point.  These  two  fields  are  always 
stored,  even  if  no  digits  are  represented.  So,  a  numeric 
string  has  a  minimum  of  seven  bytes,  the  5-byte  header,  and 
one  byte  each  for  WHL  and  FRC. 

2.2.2  SYMBOLS  (Type  DO) 

Symbols  are  stored  as  lists  of  characters  represented 
by  ASCII  values  with  one  byte  per  character.  Figure  6a 
showed  the  stringspace  for  the  symbol  "  ABC".  An  N  - 
character  symbol  is  stored  in  N  bytes.  Therefore,  NXT-5 
gives  the  length  of  the  symbol,  so  a  separate  length  field 
is  unnecessary.  A  symbolic  string  with  no  symbols  is 
considered  EMPTY. 

2.2.3  BOOLEAN  (Type  DO) 

Boolean  strings  are  a  special  case  of  symbolic  strings. 
In  order  to  be  classified  as  a  boolean  node,  a  symbol  must 
begin  with  T  for  a  TRUE  value  or  F  for  a  FALSE  value.  Any 
attempt  to  use  a  symbol  (as  a  boolean  value)  that  does  not 
begin  with  T  or  F  will  generate  an  error. 


2.2.4  SEQUENCES  (Type  EO) 

FORJR  stores  sequences  as  lists  of  indices  of  the 
objects  that  comprise  the  sequence.  The  indices  (NODEPTR,  a 
2-byte  hex  number  that  points  to  nodes  in  the  nodelist)  are 
stored  in  the  stringspace  of  the  sequence  in  the  same  order 
as  the  elements  appear  in  the  sequence.  An  N-element 
sequence  has  2*N  data  bytes,  plus  the  5-byte  header.  A 
separate  count  field  is  unnecessary  because  (NXT-5)/2  gives 
the  number  of  elements  in  the  sequence.  The  NXT  field  of  a 
sequence  of  zero  elements  (NIL  sequence)  is  exactly  equal  to 
five.  Figure  7  shows  a  sequence  constructed  of  the  numeric 
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FIGURE  7.  Sequence  of  One  Symbol  and  One  Number 

2.3  GARBAGE  COLLECTION  AND  STORAGE  COMPACTION 

Because  of  the  si n g 1 e- a s s i g nm en t  rule  in  BADJR,  many 
temporary  objects  are  generated  in  the  storage  areas.  To 
conserve  storage  space  FORJR  uses  a  node-tagging  scheme  to 
implement  garbage  collection. 

The  inheritance  stack  rises  and  falls  as  FORJR  routines 
are  called  and  results  returned.  Any  critical  attribute 
that  needs  to  be  used  again  is  either  in  the  active  stack  or 


is  referred  to  by  another  attribute.  Therefore,  it  is  safe 
to  collect  any  unreferenced  nodes. 

Garbage  collection  can  be  invoked  by  the  user  via 
COLECT  or  can  be  initiated  by  FORJR  itself  if  free  storage, 
either  nodes  or  stringspace,  is  exausted.  When  collection 
begins,  all  computation  is  halted  to  ensure  storage  remains 
fixed  until  collection  is  complete. 

Every  node  in  the  nodespace  whose  index  is  referenced 
in  the  active  inheritance  stack  is  tagged  by  setting  the  tag 
field  to  the  current  value  of  the  marker,  a  value  which 
alternates  between  0  and  1.  Therefore,  the  tag  field  of  a 
node  is  ONLY  changed  if  it  is  not  to  be  collected.  If  a  node 
is  a  sequence,  its  elements  are  marked  recursively  until  all 
referenced  elements  are  marked. 

After  tagging,  all  nodes  in  the  nodelist  are  checked 
for  the  current  tag  value.  Any  node  with  the  incorrect 
value  has  its  address  field  set  to  FFFFH  indicating  this  is 
a  collectable  node.  The  IDX  field  of  the  corresponding 
stringspace  is  also  set  to  collectable. 

After  all  nodes  and  stringspaces  have  been  checked, 
storage  is  compacted  using  a  common  method.  Starting  at  the 
base  of  the  stringspace  area,  the  compactor  checks  the  IDX 
field  of  each  stringspace  to  see  if  it  has  been  marked  for 
collection.  If  a  stringspace  is  collectable,  successive 
stringspaces  are  examined  until  the  first  un c o 1 1 ec t ab 1 e 
stringspace  is  encountered.  The  uncollected  stringspace  is 


then  "slid  up"  to  the  address  of  the  first  collectable 


stringspace.  This  c  hec  k-and- si  id  e  process  is  repeated  until 
all  uncollectable  stringspaces  are  adjacent  with  no  holes 
between  them  or  the  beginning  of  free  space  is  encountered. 
As  uncollected  stringspaces  are  moved,  the  corresponding 
pointers  in  the  nodelist  are  updated  to  reflect  the  new 
address  of  the  stringspace. 

If  a  user  invokes  the  garbage  collector  via  COLECT,  and 
no  collectable  space  exists,  the  message: 

NO  GARBAGE  FOUND 
is  printed  on  the  console. 


IV.  F OR  JR  INSTRUCTION  SYNTAX 

1.0  INTRODUCTION 

FORJR  provides  three  levels  of  instruction,  IMMEDIATE, 
PRIMITIVE,  and  RELATIONAL.  Simple  examples  explaining  the 
use  of  FORJR  instructions  are  provided  below.  The  actual 
FORTH  definitions  of  the  FORJR  Syntax  can  be  found  in 
Appendix  B,  Forth  Screen  Contents. 

The  following  is  a  list  of  FORTH  words  and  their 
respective  functions.  The  definition  of  these  functions  are 
provided  to  assist  in  understanding  the  FORJR  INSTRUCTION 
SYNTAX: 

INITSTORE  -  Initializes  the  INHERITANCE  STACK, 

NODELIST,  and  the  STRINGSPACE  storage  areas. 

{  -  Starts  a  new  FRAME  on  the  FRAME  stack.  (A  more 

complete  description  is  contained  in  Para.  4.12.5) 

}  -  Symbolizes  the  end  of  the  FRAME  construction  but  is 

for  readibility  only. 

DEFLOC  -  Provides  a  synthesized  attribute  to  be  defined 
later  by  some  FORJR  routine. 

A  1  A  2  A3  ...  All  -  Stacks  attributes  1  2  3  ...  11 

respectively  from  the  previous  FRAME  onto  the 
current  FRAME.  (The  same  operation  can  be 
accomplished  by  1  STKINH  2  STKINH  etc.) 


2.0  IMMEDIATE  INSTRUCTIONS 

Immediate  instructions  produce  a  single  attribute  with 
a  specified  attribute  type.  FORJR  defines  the  following 
immediate  functions: 

NUMERIC  CONSTANT 
SYMBOLIC  CONSTANT 
SELECT  FUNCTION 
LENGTH  FUNCTION 
CONSTRUCT  FUNCTION 
MERGE  FUNCTION 
SPECIAL  NOTES: 

(1)  Data  input  integrity  is  extremely  critical  for  the 
IMMEDIATE  INSTRUCTIONS.  Recovery  from  mistyped 
entries  may  cause  FORJR  to  abort,  particularly  when 
using  immediate  number  or  symbol  builders  inside 
SEQUENCES. 

(2)  Prior  to  executing  ANY  FORJR  instructions,  the 
data  storage  areas  must  be  initialized  via  INITSTORE. 

2.1  NUMERIC  CONSTANTS  (  #  ...  ) 

An  immediate  number  attribute  may  be  created  with  a 
maximum  of  256  digits,  including  sign  and  decimal  point. 
Negative  numbers  must  be  preceded  by  a  -  sign.  However,  the 
+  sign  is  optional  for  positive  numbers.  The  input  string 
may  contain  at  most  one  (1)  decimal  point  and  no  imbedded 
blanks.  The  pound  sign  (9)  followed  by  one  or  more  blanks 
invokes  the  immediate  numeric  constant  function.  A  blank  or 
carriage  return  following  the  desired  number  terminates  the 


immediate  constant  function. 


EXAM  PLE: 


E  XAM  PLE: 


a  ttr ib  ute) 


#12  3  ( 

#  -45  6.7  89 


(Creates  a  positive  attribute) 
3  (Creates  a  negative 


In  the  run  time  environment,  immediate  number  constants 
may  also  be  created  using  the  RDNUM  function.  After 
invoking  RDNUM,  you  may  enter  the  desired  sign,  number,  and 
decimal  point  followed  by  a  carriage  return. 

2.2  SYMBOLIC  CONSTANTS  ("  aaa'») 

An  immediate  symbolic  constant  can  be  created  by 
bracketing  a  character  string  in  double  quotes  ("  a  a  a").  A 
maximum  of  256  ASCII  symbols  may  be  contained  in  the  input 
character  string.  All  printable  ASCII  characters  (except 
double  quote  ( ")  and  control  characters)  may  be  included  in 
the  symbol.  The  symbolic  constant  builder  is  invoked  with  a 
double  quote  ( ")  followed  by  one  (1)  blank.  The  desired 
character  string  can  be  terminated  with  either  an  ending 
double  quote  (")  or  a  carriage  return.  Any  symbolic 
attribute  created  inside  a  FORTH  definition  must  terminate 
with  the  quotes.  As  with  numeric  constants,  a  runtime 
facility,  RDSYM,  exists  to  read  in  characters  from  the 
keyboard.  In  this  case,  a  carriage  return  terminates  the 


symbol  construction. 


EXAM  PLE: 


EXAM  PLE: 


"  ABC" 


"  ABC<cr>  (symbol  is  same  as  above) 


2.  3  SELECT  (S  L  or  SR  ) 

The  SELECT  function  creates  an  attribute  from  selected 
element  of  a  target  SEQUENCE.  Both  SELECTRIGHT  (SR)  and 
SELECTLEFT  (SL)  are  available  in  FORJR.  SL  choses  an 
element  indexed  into  the  sequence  from  the  left,  while  SR 
choses  the  elements  indexed  from  the  right.  The  target 
sequence  or  a  copy  of  the  target  sequence  must  be  the  top¬ 
most  attribute  in  the  frame,  otherwise  an  error  will  occur. 
In  addition,  the  index  value  must  be  less  than  or  equal  to 
the  length  of  the  sequence.  To  execute  the  SELECT  function, 
the  index  value  of  the  desired  element  is  put  onto  the  FORTH 
stack.  After  SL  or  SR  is  executed,  the  sequence  on  top  of 
the  FRAME  stack  will  be  replaced  by  the  desired  element  from 
the  sequence. 

(In  the  following  examples  assume  the  target  SEQUENCE 
is  on  top  of  the  inheritance  stack  and  contains  4 
el  ements  .) 

EXAMPLE:  1  SL  (Replaces  the  top  sequence 

with  the  first  element  of  the  sequence.) 

EXAMPLE:  4  SR  (Also  will  replace  the  top 

sequence  with  the  first  element  of  the  sequence.) 

2.4  LENGTH  (LENGTH) 

The  LENGTH  function  creates  a  numeric  attribute 
representing  the  number  of  elements  in  a  target  sequence. 
The  target  sequence  must  be  the  topmost  attribute  on  the 
current  frame  stack. 


EXAM  PLE: 


LENGTH 


(Replaces  the  top  sequence 


attribute  with  a  numeric  attribute  containing  the 
number  of  elements  in  the  sequence.) 

2.5  CONSTRUCT  (<<...>>) 

The  CONSTRUCT  function  combines  one  or  more  attributes 
into  a  single  sequence.  Other  immediate  instructions  can  be 
nested  inside  the  construct  operator.  A  pair  of  adjacent 
"less  than"  symbols,  <<,  invokes  the  CONSTRUCTOR  while  a 
pair  of  "greater  than"  symbols,  >>,  terminates  the 
CONSTRUCTOR.  The  desired  elements  are  contained  between  << 
and  >>.  The  sequence  constructor  can  be  nested  to  provide 
sequences  within  sequences. 

EXAMPLE:  {  <<  #  1  "  test"  >>  }  (Creates  a  two- 

element  sequence  containing  one  numeric  and  one 
symbolic  element.) 

EXAMPLE:  {  <<  A1  A2  A  3  >>  }  (Thisexample  assumes 

3  attributes  are  in  the  current  frame.  A  new  frame  is 
created  and  a  sequence  attribute  is  constructed  from 
three  attributes  from  the  original  frame.) 

EXAMPLE:  {  <<  RDSYM  >>  }  (Makes  a  1-element 

sequence  from  characters  input  from  the  keyboard.  The 
element  is  a  symbol  representing  the  input  string.) 
EXAMPLE:  {  <<  «  1  <<  #  2  "  ABC"  >>  >>  }  (Creates  a 

two-element  sequence.  The  first  element  is  an 
immediate  number,  the  second  element  is  a  two-element 
sequence  of  an  immediate  number  and  immediate  symbol.) 


2.6  MERGE  (  MERGE  .  .  .  CLSMER  ) 

The  MERGE  function  operates  on  one  or  more  sequences 
and  produces  a  single  sequence  containing  all  the  elements 
from  the  enclosed  sequences. 

EXAMPLE:  MERGE  A1  A2  CLSMER  (Makes  a 

sequence  of  the  elements  of  both  attribute  1  and 
attribute  2  of  the  current  frame.  NOTE:  both 

attributes  must  be  sequences.) 

EXAMPLE:  MERGE  <<  #  1  >>  <<  *•  THIS  IS  A  TEST"  >>  CLSMER 
(Creates  a  sequence  of  two  elements,  an  immediate 
numeric  element  and  an  immediate  symbolic  element.) 

3.0  PRIMITIVE  INSTRUCTIONS 

Each  primitive  instruction  has  a  predetermined  number 
of  inherited  and  synthesized  attributes.  The  number  of 
inherited  attributes  varies  depending  upon  the  type  of 
instruction.  Only  one  synthesized  attribute  is  defined  by  a 
primitive  function. 

FORJR  handles  the  following  types  of  primitive 
in  str  uc  t ions  : 

CHARACTERISTIC  FUNCTIONS 
CON  VERSIONS 

SEQUENCE  MANIPULATIONS 
ARITHMETIC  OPERATORS 
3.1  CHARACTERISTIC  FUNCTIONS 

Characteristic  functions  are  designed  to  test  the  type 
of  an  inherited  attribute.  These  functions  use  one 
inherited  attribute  as  input,  which  can  be  any  object,  and 


synthesizes  one  boolean  attribute.  The  boolean  attribute 
will  have  the  value  of  T  (for  TRUE)  or  F  (for  FALSE) 
depending  upon  the  results  of  the  test.  FORJR 
characteristic  functions  include:  ATOM?,  NIL?,  SYMBOL?, 
NUMBER?,  BOOLEAN?,  EMPTY?,  and  SEQUENCE?  Most  of  these 
functions  just  examine  the  type  field  of  the  inherited 
attribute  and  define  the  boolean  attribute  accordingly.  The 
two  functions  NIL?  (for  sequences)  and  EMPTY?  (for  symbols) 
return  T  if  the  number  of  data  bytes  in  the  stringspace  of 
the  inherited  attribute  is  zero,  and  F  otherwise.  In 
addition,  F  will  be  returned  if  NIL?  is  applied  to  a  NON- 
sequence  or  EMPTY?  is  applied  to  a  NON-symbol. 

(In  the  following  examples,  assume  that  a  frame  exists 
containing  an  inherited  attribute  and  an  undefined 
synthesized  attribute.) 

EXAMPLE:  {  A  1  A2  }  NUMBER?  (Starts  a  new  frame  and 

stacks  an  inherited  attribute  (A1)  and  a  synthesized 
attribute,  (A2).  The  type  field  of  the  first  attribute 
is  checked  and  defines  A2  as  a  boolean  T  if  A  1  is  a 
numeric  attribute,  F  otherwise.  The  frame  is  then 
reset  back  to  the  original  frame.) 

3.2  CONVERSIONS 

FORJR  has  no  automatic  or  default  conversions. 
Therefore,  any  conversion  must  be  accomplished  through 
explicit  conversion  functions.  These  functions  use  one 


inherited  and  one  synthesized  attribute. 


The  names  of  most 


of  the  conversion  functions  identify  the  type  of  conversion 
being  accomplished.  The  first  three  letters  of  the  function 
name  indicate  the  type  of  the  inherited  attribute  and  the 
last  three  letters  indicate  the  desired  conversion.  Type 
checking  is  performed  on  the  inherited  attribute. 
Therefore,  if  the  type  does  not  match  the  desired  input,  an 
error  message  is  printed  and  the  conversion  is  aborted.  The 
only  exception  to  the  naming  convention  is  the  IDENTITY 
function,  which  makes  a  duplicate  of  any  inherited 
a  ttr ib  ute  . 

F  OR  JR  provides  the  following  conversions: 

SYMBOL-TO-SEQUENCE 
SEQUE  NC  E-TO-S  YMBOL 
SEQUENCE-TO-N  UMBER 
NUMBER-TO-S  YMBOL 
I  DENT  IT  Y 

3.2.1  SYMBOL-TO-SEQUENCE  (SYMSEQ) 

SYMSEQ  creates  a  new  symbol  in  the  stringspace  for  each 
ASCII  character  in  the  inherited  attribute.  The  synthesized 
attribute  becomes  a  sequence  of  the  new  symbol  nodes. 
EXAMPLE:  {  "  ABCD”  DEFLOC  } 

{  A1  A2  }  SYMSEQ 

(Using  the  symbol  ABCD  from  the  first  frame,  a  sequence 
attribute  with  four  elements,  A,  B,  C,  D,  is  defined  in 
the  second  attribute.) 


3.2.2  SEQUENCE-TO-SYMBOL  (SEQSYM) 

SEQSYM  creates  a  new  symbol  containing  the  elements  of 
the  sequence.  If  the  sequence  contains  any  NON-symbolic 
elements,  an  error  message  is  printed  and  the  conversion  is 
aborted  . 

EXAMPLE:  {  <<  "  AB"  "  CD"  >>  DEFLOC  } 

(The  first  attribute  is  a  two  element  sequence) 

{  A  1  A  2  }  SEQS  YM 

(A  symbolic  attribute,  ABCD,  is  created  in  the  second 

attr  ibute  .) 

3.2.3  SEQUENCE-TO-NUMBER  (SEQNUM) 

SEQNUM  operates  on  a  sequence  whose  elements  are 
symbols  representing  the  digits  0-9,  +  or  -,  and  at  most  one 
decimal  point.  SEQNUM  will  convert  the  sequence  into  a 
numeric  attribute  whose  digits  match  the  elements  of  the 
sequence.  The  elements  may  be  a  series  of  symbols,  or  a 
single  character  string. 

EXAMPLE:  {  <<  "  -12.34"  >>  DEFLOC  } 

(Creates  a  sequence  with  six  symbolic  elements,  -,  1, 

2,  3»  ••  and  4.  DEFLOC  provides  a  synthesized  attribute.) 

{  A  1  A  2  }  SEQNUM 

(Creates  a  numeric  attribute,  -12.34  in  the  second 

attr  ibute  .) 

EXAMPLE:  {  <<  "  -"  "  1"  "  2"  "  ."  "  3"  "  4"  >>  DEFLOC  } 

{  A1  A2  }  SEQNUM 

(Has  the  same  effect  as  the  above  example.) 


3.2.4  NUMBER -TO -SYMBOL  (NUMSYM) 

NUMSYM  creates  a  symbolic  attribute  which  represents 
the  sign,  decimal  point,  and  digits  of  a  number. 

EXAMPLE:  {  #  123  DEFLOC  } 

(Creates  a  one  numeric  and  one  synthesized  attribute.) 

{  A  1  A  2  }  NUMSYM 

(Generates  a  symbolic  attribute  that  is  the  ASCII 
representation  of  the  number  +123.) 

3.2.5  IDENTITY  (ID) 

The  IDENTITY  function  creates  an  exact  duplicate  of  any 
defined  object,  including  numbers,  symbols,  and  sequences. 
EXAMPLE:  {  "  test"  DEFLOC  } 

(A  symbol,  test,  is  created  and  a  synthesized  attribute 
prov  id  ed  .) 

{  A  1  A  2  }  ID 

(Makes  the  second  attribute  an  exact  duplicate  of  the 
first  . ) 

3.3  SEQUENCE  MANIPULATIONS 

Major  order  and  space  transformations  are  performed  on 
sequences  in  FORJR.  These  manipulation  functions  consist 
o  f : 

DISTRIBUTION 
REVERSE 


SELECTION 


3.3.1  DISTRIBUTION  (DL  or  DR) 

There  are  two  forms  of  the  distribution  function,  DL 

(DISTR  IBUTE-LEFT)  and  DR  (  D  I S  TR  IB  UTE -R  I  G  HT ) .  Each  version 
must  have  two  inherited  attributes  and  one  synthesized 
attribute.  The  first  inherited  attribute  must  be  a 
sequence,  the  other  some  object.  After  the  function  call, 
the  synthesized  attribute  becomes  a  sequence  with  the  same 
length  as  the  inherited  sequence.  Each  element  of  the  new 
sequence  is  a  sequence  of  length  two  consisting  of  an 
individual  elements  from  the  original  sequence  prefixed  (DL) 
or  suffixed  (DR)  with  the  object. 

EXAMPLE:  {  «  #  3M  #  56  >>  "  ABC"  DEFLOC  } 

(A  frame  with  three  attributes,  (1)  a  2-element 
sequence,  (2)  the  symbol  ABC,  (3)  a  synthesized 
attr  ibute  .) 

{  A  1  A2  A  3  }  DL 

(Defines  the  third  attribute  as  a  sequence  with  the 
following  characteristics: 

<<  <<  "  ABC"  if  34  >>  <<  "  ABC"  if  56  >>  >>  .) 

3.3.2  REVERSE  (RV) 

The  REVERSE  function  makes  a  sequence  by  copying  all 
the  elements  of  the  inherited  sequence  in  reverse  order. 
EXAMPLE:  {  <<  if  1  if  2  if  3  »  DEFLOC  } 

(A  frame  with  two  attributes,  (1)  a  3-element  sequence, 
(2)  a  synthesized  attribute.) 

{  A  1  A2  }  RV 

(Defines  the  synthesized  attribute  as  a  3  element 


se  quence  : 


<<#3#2#1>>  .) 

3.  3.  3  SELECT  (SEL  or  SER) 

The  primitive  SELECT  is  not  to  be  confused  with  the 
immediate  SELECT  function.  The  primitive  SELECT  operates 
entirely  from  attributes,  including  the  index  of  the  desired 
sequence  element.  The  number  represented  by  the  numeric 
attribute  must  be  equal  to  or  less  than  the  length  of  the 
sequence.  After  the  SELECT  function  call,  the  synthesized 
attribute  is  defined  as  the  selected  element  of  the 
se  quence  . 

EXAMPLE:  {  <<  0  123  0  456  #  789  >>  It  2  DEFLOC  } 

(A  frame  with  three  attributes,  (1)  a  3-element 
sequence,  (2)  a  numeric  attribute,  (3)  a  synthesized 
attr  ib  ute  .) 

{  A  1  A2  A3  }  SEL 

(Defines  the  synthesized  attribute  with  the  second 
element  of  the  sequence,  i  .e .  the  number  +456.) 

3.4  ARITHMETIC  OPERATORS 

F  OR  JR  numbers  are  implemented  as  fixed  point  decimals 
and  stored  in  packed  BCD  format.  All  attributes  used  as 
operands  should  be  numeric  types.  After  computation,  the 
result  is  normalized  before  storing  in  the  stringspace. 
Normalization  is  accomplished  by  stripping  leading  or 
trailing  zeros.  However,  because  the  decimal  point  falls  on 
a  byte  boundary,  there  may  be  one  leading  zero  digit  and 
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trailing  zero  digit. 

FOR  JR  provides  the  following  arithmetic  functions: 

ADDITION 

SUBTRACTION 

MULTI  PLICATION 

DI  VISION 

ABSOLUTE  VALUE 

NEGATION 

INTEGER 

3.  4.  1  ADDITION  (  AD) 

For  addition  and  subtraction  the  number  of  digits  to 
the  right  of  the  decimal  point  in  the  result  is  the  same  as 
the  larger  of  the  two  operands.  The  addition  operator  uses 
two  numeric  attributes  and  defines  a  synthesized  attribute 
as  the  sum  of  the  two  numbers. 

EXAMPLE:  {  //  1  #  2  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 
attr  ibute  .) 

{  A  1  A  2  A  3  }  AD 

(The  synthesized  attribute  is  defined  and  represents 
the  number  +  3  • ) 

3.4.2  SUBTRACTION  (SB) 

This  operator  uses  two  numeric  attributes  and  defines  a 
synthesized  attribute  as  the  difference  of  the  two  numbers. 
EXAMPLE:  l  #  10  //  15  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 


attr ibutes  . ) 


{  A  1  A  2  A  3  }  SB 

(The  synthesized  attribute  is  defined  as  -5.) 

3.4.3  MULTIPLICATION  (ML) 

In  multiplication,  the  number  of  significant  digits  in 
the  result  is  computed  as  the  sum  of  significant  digits  in 
the  operands,  normalized  as  above.  The  multiplication 
operator  uses  two  numeric  attributes  and  defines  a 
synthesized  attribute  as  the  product  of  the  two  numbers. 
EXAMPLE:  {  If  2  If  6  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 
attr  ibute  .) 

{  A  1  A2  A3  )  ML 

(The  synthesized  attribute  is  defined  as  +12.) 

3.4.4  DIVIDE  (DV) 

The  divide  operator  will  always  produce  at  least  six 
decimal  digits  normalized  as  above.  This  operator  uses  two 
numeric  attributes  and  defines  a  synthesized  attribute  as 
the  dividend  of  the  two.  Division  by  zero  is  prohibited.  If 
an  attempt  is  made  to  divide  by  zero,  the  operation  will  be 
aborted,  and  the  synthesized  attribute  will  remain 
und  efin  ed  . 

EXAMPLE:  {If  -  2.3  #  2  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 
attr ib  ute  .) 

{  A  1  A2  A3  )  DV 

(The  synthesized  attribute  is  defined  as  -1.15.) 


EXAMPLE: 


{  t  1  #  0  DEFLOC  } 


(Establish  a  frame  with  two  numeric  and  one  synthesized 
attr  ibutes  .) 

{  A  1  A  2  A  3  )  D  V 

(An  error  is  generated  because  of  the  attempt  at 
division  by  zero.  The  synthesized  attribute  remains 
und  efined  .) 

3.4.5  ABSOLUTE  VALUE  (AB) 

This  operator  makes  a  copy  of  the  inherited  numeric 
attribute  but  sets  the  type  field  to  a  positive  numeric 
v  al  ue  . 

EXAMPLE:  {  #  -1.23  DEFLOC  } 

(Establish  a  frame  with  a  negative  numeric  attribute 
and  a  synthesized  attribute.) 

{  Al  A2  }  AB 

(Defines  the  synthesized  attribute  as  +1.23.) 

3.4.6  NEGATION  (NG) 

This  operator  produces  a  copy  of  the  inherited  numeric 
attribute  but  changes  the  sign  of  the  number  by  reversing 
the  type  field  to  the  opposite  of  the  original  number. 
EXAMPLE:  {  i  +4.56  DEFLOC  } 

(Establish  a  frame  with  a  positive  numeric  attribute 
and  a  synthesized  attribute.) 

{  A  1  A2  }  NG 

(Defines  the  synthesized  attribute  as  -4.56.) 


3.4.7  INTEGER  (INT) 


This  operator  defines  a  synthesized  attribute  with  just 
the  integer  portion  of  an  inherited  numeric  attribute. 
EXAMPLE:  {  #1  6.  789  DEFLOC  } 

(Establish  a  frame  with  a  numeric  attribute 
representing  the  number  16.789  and  a  synthesized 
attribute  .) 

{  A  1  A  2  }  INT 

(Defines  the  synthesized  attribute  as  +16.) 

3.4.8  MOD  (MD) 

The  MOD  function  operates  in  standard  manner,  producing 
only  the  remainder  as  an  integer  .  The  function  uses  two 
numeric  attributes  and  defines  a  synthesized  attribute  as 
the  MOD  of  the  two  numbers.  The  input  numbers  are  first 
converted  to  integers  via  the  INT  function  described  above. 
EXAMPLE:  {  #  180  t  25  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 
attribute  . ) 

{  A  1  A2  A3  )  MD 

(The  synthesized  attribute  is  defined  as  +5.) 

(1  80  MOD  25  =  5.) 

3. 5  LOGICAL  OPERATORS 

The  normal  logical  operations  AND,  OR,  Exclusive  OR, 
and  NOT  are  provided  in  FORJR.  The  FORJR  names  for  these 
function  calls  are:  BAND,  BOR,  BXOR,  and  BNOT,  respectively. 
With  the  exception  of  BNOT,  each  operates  on  two  inherited 


boolean  attributes  and  defines  a  synthesized  attribute  with 
the  appropriate  boolean  value,  TRUE  (T),  or  FALSE  (F).  BNOT 
uses  only  one  inherited  and  one  synthesized  attribute. 

(For  each  of  the  following  examples,  use  the  frame: 

{  n  t it  ii  F”  "  T"  DEFLOC  } 

Where  the  first  three  attributes  are  boolean  attributes 
and  the  forth  is  a  synthesized  attribute.) 

EXAMPLE:  {  A  1  A  3  A  4  }  BAND 

(Defines  the  synthesized  attribute  as  a  boolean  TRUE.) 

V 

EXAMPLE:  {  A  1  A2  A4  )  BOR 

(Defines  the  synthesized  attribute  as  a  boolean  TRUE.) 
EXAMPLE:  {  A 1  A3  A4  }  BXOR 

(Defines  the  synthesized  attribute  as  a  boolean  FALSE.) 
EXAMPLE:  {  A1  A4  }  BNOT 

(Defines  the  synthesized  attribute  as  a  boolean  FALSE.) 

3.6  RELATIONAL  OPERATORS 

The  relational  operators  discussed  in  the  BA D JR  report 
compare  the  types  and  values  of  two  inherited  attributes. 
The  precedence  order  used  for  comparing  attributes  is  as 
follows  : 

NUMBERS  <  SYMBOLS  <  SEQUENCES. 

A  synthesized  attribute  is  defined  with  a  boolean 
value,  TRUE  (T )  or  FALSE  (F)  as  a  result  of  the  conparison. 
If  the  attributes  in  the  comparison  are  sequences,  the 
relational  operators  check  the  sequence  lengths  and 
considers  shorter  sequence  as  preceding  longer  sequences.  If 


the  sequences  are  of  the  same  length,  the  relational 
operator  compares  the  individual  elements  inside  the 
sequences  and  awards  precedence  based  on  the  above  criteria 
and  defines  the  synthesized  attribute  accordingly.  The 
FORJR  names  for  the  relational  instructions  are: 

EQ? 

NE? 

LT? 

LE? 

GT? 

GE? 

EXAMPLE:  {  #  3.  1  #  2.5  DEFLOC  } 

(Establish  a  frame  with  two  numeric  and  one  synthesized 
attr ib  ute  .) 

{  A  1  A2  A3  )  GT? 

(Since  3.1  is  greater  than  2.5,  the  synthesized 
attribute  is  defines  as  TRUE  (T).) 

EXAMPLE:  {  "  ABC"  #  123  DEFLOC  } 

(Establish  a  frame  with  one  symbolic  atom,  one  numeric 
atom,  and  a  synthesized  attribute.) 

{  A  1  A2  A3  }  LE? 

(Because  of  the  precedence  order  established  between 
symbols  and  numbers,  i.e.  NUMBERS  <  SYMBOLS,  the 
synthesized  attribute  is  defined  as  FALSE  (F)  .) 

EXAMPLE:  {  0  999  <<  #  0  >>  DEFLOC  } 

(Establish  a  frame  with  one  numeric  atom,  a  sequence 
containing  one  numeric  atom,  and  a  synthesized 


attr ibute  . ) 


{  A  1  A2  A3  }  GT? 

(Because  atoms  have  a  lower  precedence  value  than 
sequences,  the  synthesized  attribute  would  be  defined 
as  a  boolean  FALSE  (F).) 

EXAMPLE:  {  <<  "  AM  >>  <<  #  1  //  2  //  3  >>  DEFLOC  } 

(Establish  a  frame  with  two  sequences  and  one 

synthsized  attribute.  The  the  first  sequence  contains 
one  symbolic  atom  the  second  sequence  contains  three 
num  eric  atom  s) 

{  A  1  A2  A3  }  LT? 

(The  synthesized  attribute  is  defined  as  TRUE  (T) 
because  the  length  of  the  first  sequence  is  one  as 
compared  to  a  length  of  three  for  the  second  sequence.) 
EXAMPLE:  {  <<  "  CAT"  >>  <<  "  DOG"  >>  DEFLOC  } 

(Establish  a  frame  with  two  sequences  and  one 

synthesized  attribute.) 

{  A  1  A  2  A  3  }  GT? 

(Since  the  sequence  lengths  are  equal,  the  relational 
instruction  must  compare  the  contents  of  each  sequence. 
Since  CAT  is  NOT  lexigraphically  "greater  than"  DOG, 
the  synthesized  attribute  is  FALSE  ( F) .) 

H.O  OTHER  F  OR  JR  INSTRUCTIONS 

Along  with  the  FORJR  instructions  listed  in  the 

introduction  to  Section  IV,  there  are  a  number  of  FORJR 


instructions  dealing  with  the  FORJR  environment. 


Ex  am  pi  es 


are  included  if  the  function  call  involves  frame 
manipul ation  . 

4.1  I/O  FUNCTIONS  (RDNUM,  RDSYM,  PRNUM,  PRSYM,  PRBUL) 

To  prevent  conflicting  file  handling  problems  all  I/O 
operations  are  done  from  FORTH.  Number  and  character  input 
routines  (RDNUM,  RDSYM)  are  immediate  and  described  in 
paragraph  2.0,  above.  However,  output  functions  (PRNUM, 
PRSYM,  PRBUL)  act  as  primitive  operators  and  must  function 
on  inherited  attributes. 

EXAMPLE:  {  It  1.23  "  TRUE"  } 

(Establish  a  frame  with  a  numeric  and  symbolic 

attribute.  Use  this  frame  for  the  following  examples.) 
{  A  1  }  PRNUM 

(Results  in  a  console  output:  +1.23). 

{  A  2  }  PRSYM 

(Results  in  a  console  output:  TRUE) 

{  A  2  }  PRBUL 

Since  the  symbolic  attribute  begins  with  a  "T"  ,  the 
boolean  print  operator  will  also  function  on  this  attribute. 
If  the  boolean  print  operator  is  applied  to  a  NON-boolean 
attribute,  an  error  occurs. 

EXAMPLE:  {  A  2  )  PRBUL 

(Results  in  a  console  output: 

BOOLEAN  VALUE  =  TRUE.  ) 


4.2  FRAME  STATUS  (FRAME) 

The  F  OR  JR  word  FRAME  causes  a  dump  of  the  current  frame 
providing  the  beginning  address  of  the  current  frame  on  the 
INHERITANCE  stack.  The  type  of  each  attribute  in  the  frame 
is  printed,  and  if  the  attribute  is  a  number  or  symbol,  the 
attribute  itself  is  printed.  However,  if  the  attribute  is  a 
sequence,  only  the  sequence  length  is  printed. 

4.3  MEMORY  STATUS  (DUMPINH,  DUMPNOD,  DUMPSTR) 

The  memory  status  words  execute  256-byte  dumps  of  the 
respective  memory  areas,  the  FRAME  STACK,  the  NODESPACE,  and 
the  STRTNGSPACE. 

4.4  POP  ATTRIBUTE  (POPINH) 

The  word  POPINH  deletes  the  top  attribute  from  the 
current  frame. 

4. 5  RESET  FRAME  (RSTINH) 

RSTINH  resets  the  frame  back  to  the  original  (previous) 
fr  ame  . 

4.6  GARBAGE  COLLECTOR  (COLECT) 

A  full  description  of  the  garbage  collection  system  is 
provided  in  Section  II,  paragraph  4.3>  GARBAGE  COLLECTION 
AND  STORAGE  COMPACTION. 

4.7  EXECUTION  CONTROL  (QUES) 

The  function  QUES  interrogates  a  boolean  attribute  and 
returns  a  one  (1)  to  the  FORTH  stack  if  the  boolean  is  TRUE 
(T),  or  a  zero  (0)  if  the  boolean  is  FALSE  (F).  Flow  of 
execution  through  a  FORJR  line  is  accomplished  using 
standard  FORTH  if-then-else  convention. 
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EXAMPLE:  (Write  a  FORTH  test  routine  that  prints  the 

larger  of  two  numbers  from  a  frame.) 

{  #  123  //  456  DEFLOC  } 

(Establish  a  frame  with  two  numeric  attributes,  and  one 
synthesized  attribute.) 

:  TEST&PR INT  (  FORTH  test  routine  ) 

{  A  1  A  2  A3  }  GT?  (IS  A1  >  A2  ?  ) 

{  A3  }  QUES  (Test  the  boolean  attribute) 

IF  {  A1  }  PRNUM 

ELSE  {  A  2  }  PRNUM  ENDIF  ; 

4.8  FRAME  SLIDER  (SLIDE) 

The  FORJR  function  SLIDE  moves  the  current  frame  down 
on  top  of  the  previous  frame.  This  is  designed  to  optimize 
utilization  of  memory  space  and  facilitates  recursive  FORJR 
calls. 

4.9  ENHANCED  FORJR  SYNTAX 

Several  FORJR  words  have  have  been  defined  that  make 
FORJR  syntax  resemble  more  closely  the  BADJR  syntax  as  given 
in  the  original  BADJR  Report.  The  same  functions  are 
provided  in  other  forms,  but  these  words  simplify 
programming  in  FORJR  and  provide  more  readable  code.  Some 
of  the  enhanced  syntax  functions  can  be  used  in  a  "live" 
environment,  while  others  are  designed  to  be  used  inside 
FORJR  function  definitions. 


4.9.1  ATTRIBUTE  NAMING/STACKING  CONVENTIONS 

A  FORJR  compile  time  facility  allows  the  user  to  refer 
to  attributes  by  name  rather  than  by  number.  Because  each 
attribute  name  is  given  a  separate  FORTH  dictionary  entry, 
it  is  not  advisable  to  put  this  facility  inside  a  FORJR 
program  definition.  In  order  to  use  this  facility,  the  user 
must  follow  the  syntax  precisely. 

EXAMPLE:  {{  ~  xxx  ~  yyy  *  -  aaa  ~  bbb  }} 

The  attribute  naming  procedure  is  initiated  by  a  pair 
of  adjacent  left  "curly  brackets",  {{.  There  must  be  no 
spaces  between  the  two  left  brackets.  A  right  pair  has  been 
provided  but  is  for  readability  only. 

A  single  "up  carat"  followed  by  some  character  string 
associates  an  integer  value  with  the  attribute  stacking 
routine,  STKINH.  The  variable  ATTCOUNT  is  initialized  to 
zero  via  {{.  Every  time  ~  or  * ~  is  used,  ATTCOUNT  is 
incremented  by  one.  The  new  value  of  ATTCOUNT  is  included 
in  the  definition  of  the  current  attribute  being  named.  In 
the  above  example,  xxx  becomes  a  FORTH  word  with  the 
following  characteristics: 

:  xxx  1  STKINH  ; 

When  executed,  xxx  stacks  the  first  attribute  from  the 
previous  frame  onto  the  current  frame.  The  FORTH  word  yyy 
would  stack  the  second  attribute. 

The  double  carat,  *  *  ,  assigns  the  next  integer  in 

ATTCOUNT  to  a  character  string  and  causes  the  string  to 
behave  as  the  single  carat  routine.  However,  the  double 
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carat  routine  implies  that  the  attribute  referenced  is  a 
local  attribute.  A  variable,  LOCCOUNT,  keeps  track  of 
the  total  number  of  local  attributes  desired.  In  the 
example,  aaa  has  a  definition  resembling: 

:  aaa  3  STKINH 

The  function  bbb  is  defined  as: 

:  bbb  4  STKINH  ; 

4.9.2  DEFINING  SYNTHESIZED  ATTRIBUTES  (LOC) 

Using  the  value  contained  in  LOCCOUNT  as  described 
above,  the  desired  number  of  local  attributes  can  be 
requested  quickly  and  easily  via  the  function  LOC.  A  loop 
is  performed  that  executes  the  function  DEFLOC  once  for  each 
local  attribute  desired.  In  the  above  example,  is 

used  twice,  LOCCOUNT  is  two,  and  two  local  attributes 
would  be  created.  The  function  aaa  would  stack  the  first 
local  attribute,  bbb  the  second. 

The  LOC  facility  has  a  limitation  that  dictates  it  MUST 
be  used  inside  a  FORJR  program  definition.  Any  attempt  to 
use  LOC  in  a  live  environment  will  produce  nil  results. 

4.9.3  INHERITED  iSYNTHESIZED  ATTRIBUTE  SEPARATOR  (!) 

The  dummy  FORJR  command,  !  .exists  that  enhances 
readability.  This  function  does  nothing,  but  when  used  it 
becomes  readily  apparent  which  attributes  are  inherited,  and 
which  are  synthesized. 
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4.10  TOPMOST  ATTRIBUTE  STACKER  (>«*) 

Occasionally,  an  attribute  is  generated  on  top  of  the 
current  frame  but  the  user  does  not  know  which  attribute 
number  it  is.  Although  FRAME  lists  out  all  the  attributes 
in  the  current  frame,  executing  FRAME  inside  a  program 
definition  may  not  be  desirable.  Therefore,  a  facility 
exists,  >**,  that  stacks  the  topmost  attribute  from  the 
previous  frame  onto  the  current  frame. 

4.11  SEQUENCE  LENGTH  (SEQLEN) 

This  function  returns  to  the  FORTH  stack  an  integer 
value  that  is  the  length  (number  of  elements)  of  a  sequence. 
The  desired  sequence  must  be  the  topmost  attribute,  or  the 
only  attribute  in  a  frame  because  after  SEQLEN  is  called, 
the  frame  is  reset  back  to  the  previous  frame.  The  best  way 
to  use  this  facility  is  to  start  a  new  frame  and  stack  the 
desired  sequence  onto  it  and  then  call  SEQLEN. 

EXAMPLE:  {  <<  #  1  #  22  #  33  >>  ) 

(Establish  a  frame  with  a  sequence  of  three  elements.) 

{  A 1  }  SEQLEN 

(Results  in  the  number  3  on  the  FORTH  stack.) 

4.12  F  OR  JR  RECURSIVE  INSTRUCTIONS 

Certain  FORTH  instructions  provide  recursive 
capabilities  for  FORJR  lines.  These  instructions  themselves 
do  not  interface  with  the  Z-80  assembly  code  but  provide  the 
environment  for  recursion  in  FORJR. 

The  flow  of  execution  in  FORTH  is  governed  by  the 


addresses  of  functions  that  are  contained  on  the  FORTH 


return  address  stack.  When  one  FORTH  word  calls  another 
FORTH  word,  the  Program  Field  Address  (PFA)  of  the  next  word 
to  be  executed  in  the  calling  word  is  pushed  onto  the  FORTH 
return  address  stack.  The  principle  of  recursion  used  in 
FORJR  is  to  replace  this  PFA  on  the  return  address  stack 
with  the  PFA  of  the  recursive  routine.  Every  time  this 
replacement  action  takes  place,  the  recursive  routine  is 
executed  again.  If  the  recursive  routine  is  not  to  be 
executed  again,  the  PFA  of  a  dummy  routine  is  pushed  onto 
the  return  address  stack  and  execution  resumes  in  the 
calling  word  . 

4.12.1  Null  FORTH  Word  (DUMWORD) 

DUMWORD  is  a  null  FORTH  routine  whose  address  is  used 
in  the  function  BOL,  described  below. 

4.12.2  FORTH  Word  Address  Holder  (EXWORD) 

EXWORD  is  a  variable  used  to  hold  the  addresses  of 
FORTH  routines.  The  contents  of  this  variable  are  put  onto 
the  FORTH  return  stack  via  EXX,  described  below. 

4.12.3  Begining  of  Line  Word  (BOL) 

BOL  signifies  the  begining  of  a  FORJR  line.  This 
function  stores  the  Program  Field  Address  (PFA)  of  the  null 
routine,  DUMWORD,  into  EXWORD. 

4.12.4  Execution  Address  Stacker  (EXX) 

EXX  has  two  functions:  (1)  Pushes  the  value  of  EXWORD 

(which  is  always  a  PFA  of  some  FORTH  word,  either  a  dummy 
function,  or  a  recursive  routine):  (2)  Stores  the  PFA  of 
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DUMWORD  into  EXWORD.  After  EXX  has  executed,  the  FORTH  word 
whose  PF  A  was  pushed  onto  the  return  address  stack  is 
ex  ec  uted  . 

4.12.5  New  Frame  Starter  (  {  ) 

The  new  frame  starter,  {  ,  has  two  functions:  (1) 

Executes  EXX,  thereby  pushing  the  PF A  contained  in  EXWORD 
onto  the  FORTH  return  address  stack;  (2)  Starts  a  new  frame 
by  calling  SETINH. 

4.12.6  End  of  Line  (EOL) 

The  end  of  a  FORJR  line  is  signified  by  EOL.  This 
function  has  three  responsibilities:  (1)  Drops  the  PF A  of 

the  next  FORTH  word  to  be  executed  from  the  return  address 
stack,  thereby  preventing  that  word  from  executing;  (2) 
Slides  the  current  frame  down  over  the  preceding  frame  via 
SLIDE;  (3)  Calls  EXX.  Basically,  besides  calling  SLIDE,  EOL 
switches  the  PF A  of  the  next  word  on  the  return  address 
stack  with  the  PFA  contained  in  EXWORD. 

4.12.7  Initial  Function  Name  Setup  (BADJR) 

Since  a  dictionary  entry  must  previously  exist  for 
every  FORTH  word  executed,  BADJR  is  used  to  create  a  dummy 
entry.  BADJR,  using  run  time  procedures,  defines  a  function 
with  the  following  characteristics:  (1)  The  function 

contains  a  variable,  initially  zero;  (2)  The  function  stores 
the  value  of  its  variable  into  EXWORD.  The  intent  behind 
BADJR  is  to  replace  the  zero  in  the  variable  with  the  PFA  of 
a  recursive  FORJR  line.  Therefore,  when  the  function  is 
called,  it  sets  up  recursion  by  puttine  its  own  PFA  into 


EXWORD 


EXAMPLE:  BADJR  FACT 

4.12.8  PFA  Swapping  Routine  (DEFINE) 

DEFINE  replaces  the  zero  in  the  variable  associated 
with  a  function  set  up  by  BADJR  with  the  PFA  of  a  recursive 
FORJR  line.  The  calling  sequence  for  DEFINE  is: 

[  ’  function-name  DEFINE  ] 

where  function-name  is  the  name  of  a  function  previously  set 
up  by  BADJR.  This  series  of  commands  must  be  contained 
inside  the  definition  of  a  FORJR  line.  The  square  brackets, 
[...],  suspend  compilation  of  the  line  to  perform  the 
instructions  within.  [  *  function-name  DEFINE  ]  replaces 
the  zero  in  the  variable  associated  with  function-name  with 
the  PFA  of  the  line  currently  being  defined.  Therefore, 
when  the  routine  function-name  is  called,  the  PFA  of  the 
FORJR  line  is  stored  into  EXWORD. 

EXAMPLE:  :  LINE1 

[  •  FACT  DEFINE  ] 

(FORJR  instructions  go  here).  .  .  ; 

Any  references  to  FACT  inside  the  definition  of  LINE1  will 
cause  LINE1  to  be  executed. 

5.0  FORJR  RECURSIVE  EXAMPLE 

The  following  is  an  example  of  a  FORJR  recursive 
routine  that  computes  the  factorial  of  an  input  value.  This 
example  uses  the  enhanced  FORJR  syntax  and  recursive 
instructions.  The  Roman  numerals  out  to  the  right  refer  to 


EXAMPLE 


{{  "x 

A 

Y 

*  z 

~  A  B  ~  C  }} 

(  i) 

BAD  JR  FACT 

(ii) 

:  LINE1 

(iii) 

[  • 

FACT 

DEFINE 

] 

(  iv) 

LOC 

(  v) 

{  Y 

#  1 

!  A  } 

LE? 

( v  i ) 

{  A 

} 

QUES 

( vii) 

IF  { 

# 

1 

X  |  Z 

}  ML 

(vii i) 

ELSE 

(ix) 

{ 

Y 

# 

1  !  B 

}  SB 

(  x) 

{ 

X 

Y  !  C 

}  ML 

(xi) 

{ 

C 

B  |  Z 

}  FACT  END  IF 

(xii) 

EOL 

• 

9 

( xiii) 

:  FACTOR 

IN ITSTORE 

( x  iv) 

{  DEFLOC  } 

(XV) 

{  # 

1  RDNUM  | 

At  1  FACT 

( XV  i) 

{  A  1 

}  PRNUM 

EOL  ; 

( xv ii) 

COMMENTS: 

(  i)  Provides  five  attribute  names  and  associates  each 
name  with  the  attribute  stacking  routine,  STKINH.  In 
addition,  sets  LOCCOUNT  to  three  thereby  providing  for 
three  local  attributes  when  LOC  is  executed. 

(ii)  Provides  a  dictionary  entry  for  FACT.  When  FACT 
is  called,  a  value  associated  with  FACT  (a  PFA)  is 
stored  into  EXWORD. 


(iii)  :  LINE1  ...  starts  the  FORJR  function  definition. 

(iv)  Assigns  the  PF  A  of  LINE1  to  FACT.  When  FACT  is 
called  now,  the  PFA  of  LINE1  is  stored  into  EXWORD. 

(v)  The  up-carat,  *  *  ,  is  used  three  times  in  defining 
the  attribute  names.  Therefore,  LOC  provides  three 
local  attributes. 

(vi)  Compares  Y  with  an  immediate  numeric  1.  The 
attribute  A  will  be  defined  as  a  boolean  T  or  F 
depending  upon  the  results  of  the  comparison. 

(vii)  Checks  the  boolean  value  of  A  and  returns  1  or  0 
to  the  FORTH  stack  if  A  is  T  or  F,  respectively. 

(viii)  Using  the  FORTH  IF -THEN -ELSE  structure,  LINE1 
either  executes  line  viii  or  proceeds  with  lines  ix 
through  xii  depending  upon  the  results  of  lne  vii. 

(xii)  If  the  ELSE  condition  is  executed,  FACT  stores 
the  PFA  of  LINE  1  into  EXWORD. 

(xiii)  At  the  end  of  LINE!,  EOL  replaces  the  address 
on  top  of  the  FORTH  return  address  stack  with  the 
contents  of  EXWORD.  If  EXWORD  contains  the  PFA  for 
LINE  1 ,  LINE1  will  be  executed  again.  If  EXWORD 
contains  the  PFA  for  DUMWORD,  recursion  ends  and 
processing  continues  in  the  calling  word,  FACTOR. 

(xiv)  Sets  up  the  dictionary  entry  for  FACTOR  and 
initializes  the  data  storage  areas  via  INITSTORE. 

(xv)  Defines  a  local  attribute  that  will  contain  the 
factorial  of  the  input  number. 


(xvi)  Sets  up  a  frame  with  an  immediate  numeric  1,  an 
input  value  that  is  read  from  the  keyboard  via  RDNUM, 
and  the  local  attribute  provided  in  line  (xv).  FACT 
puts  the  PFA  of  LINE1  into  EXWORD.  LINE1  is  not 
actually  executed  at  this  time,  however. 

(xvii)  The  first  {  in  this  line  causes  the  PFA 
contained  in  EXWORD  to  be  pushed  onto  the  FORTH  return 
stack  which  in  this  case  is  the  PFA  for  LINE  1 .  After 
the  return  from  LINE-!,  the  result  is  printed  via  PRNUM. 
Another  EOL  is  executed  sliding  the  current  frame  down 
over  the  previous  frame. 


CONCLUSION 


The  primary  objective  to  implement  an  interactive  BADJR 
functional  programming  machine  was  achieved  by  the  FORJR 
project.  The  only  BADJR  functions  currently  not  implemented 
in  FORJR  are  STREAM  processing  and  the  higher  level 
functions  as  contained  in  the  BADJR  Report.  The  structure 
of  FORJR  dictionary  entries  provided  a  syntax  that  closely 
resembled  BADJR.  Because  FORJR  is  interactive,  it  was  more 
difficult  to  compare  the  processing  speed  of  FORJR  versus 
other  implementations  of  BADJR.  Outward  appearances  suggest 
FORJR  is  rather  slow.  However,  its  interactive  behavior  may 
compensate  for  its  speed. 

FORJR  can  be  run  on  systems  with  CP/M  based  operating 
systems.  A  limiting  factor  might  be  its  size.  Currently, 
FORJR  requires  over  53k  of  storage  to  load  and  execute,  and 
only  8k  of  FORTH  User  Dictionary  space  is  available. 

Programming  in  FORJR  should  be  relatively  easy  for 
those  individuals  already  familiar  with  FORTH.  Frame 
building,  attribute  passing,  and  the  effects  on  storage 
after  FORJR  function  calls  are  areas  of  FORJR  one  should 
become  most  familiar  with  first.  After  achieving  a  thorough 


understanding  of  these  aspects  of  FORJR,  experimenting  with 
recursive  FORJR  functions  can  be  examined.  The  interactive 
behavior  of  FORJR  allows  simple  FORJR  functions  to  be  built 
and  tested  in  a  live  environment.  However,  more  complex 
functions  should  be  created  in  FORTH  screens  to  be  loaded 
and  tested.  As  one  studies  the  workings  of  FORJR,  extensive 
use  of  the  frame  print  and  storage  area  dump  routines  is 
suggested.  Through  the  use  of  these  facilities,  the  user 
can  see  the  effects  that  FORJR  commands  have  on  the 
different  storage  areas  and  how  these  areas  are  related. 

Future  extensions  to  FORJR  might  involve  implementation 
of  some  of  the  high  level  BADJR  functions.  Since  the 
addresses  of  all  areas  of  the  data  structures  are  available 
in  FORJR,  implementing  the  high  level  functions  that  involve 
sequences  seems  plausible.  Another  consideration  is 
modifying  the  size  of  FORJR.  Developing  a  paging  scheme 
that  swaps  out  the  unused  portions  of  the  Z-80  assembly  code 
is  another  possible  area  of  investigation. 

An  interesting  observation  was  made  while  developing 
the  FORJR  system.  The  successful  linking  of  FORTH  to 
another  separate  and  distinct  system  seems  to  suggest  that 
FORTH  can  be  appended  to  the  front  of  other  systems,  thereby 
extending  and  providing  increased  flexibility  to  these 


systems  as  well 


APPENDIX  A 


SYSTEMS  PROGRAMMER  GUIDE 

1.  USING  FOR  JR 

The  FORJR  system  combines  a  FORTH  full-screen  editor 
system  with  Z-80  assembly  language  modules  which  have  been 
merged  into  a  single  executable  file,  FORJR.COM.  Normally, 
FORJR  can  be  run  under  CP/M  simply  by  typing: 

FORJR 

However,  the  loader  in  some  systems  is  over  written  when  the 
FORJR  system  is  invoked.  In  these  cases,  FORJR  can  be 
loaded  and  executed  using  CP/M's  Dynamic  Debugging  Tool 
(DDT).  The  format  for  this  method  is: 

DDT  FORJR.COM 

DDT  will  load  the  FORJR  system  beginning  at  address  lOOh. 
After  the  load  is  complete,  type: 

G  1  00 

If  loading  under  DDT,  the  system  will  not  come  up  with 
a  valid  .SCR  file.  You  must  specify  any  desired  screen  file 
via  the  USING  command: 

USING  filename 

Where  "filename"  is  the  name  of  the  desired  screen  file. 
(NOTE:  The  desired  file  MUST  have  a  .SCR  extension.) 


Prior  to  executing  ANY  FORJR  commands,  it  is  IMPERATIVE 


that  the  data  storage  areas  be  initialized  via: 

INITSTORE 

If  you  fail  to  do  this,  FORJR  loses  track  of  itself  and  the 
system  will  have  to  be  reset.  If  you  define  test  programs 
inside  FORTH  words,  it  is  suggested  that  you  include 
INITSTORE  as  part  of  the  function  definition. 

2.  MODIFYING  Z-80  SOURCE  FILES 

If  desired,  the  Z-80  source  modules  of  FORJR  can  be 
modified  to  expand  the  scope  of  FORJR.  Also,  smaller 
versions  of  FORJR  can  be  created  by  deleting  unnecessary 
mod  ules . 

There  are  thirteen  separate  Z-80  assembly  language 
source  files  that  are  used  in  FORJR.  Table  C-1  is  a  list  of 
these  source  files  with  a  short  description  of  the  functions 
of  each  module.  In  addition,  the  major  subroutines  of  each 
module  are  listed.  However,  the  user  does  not  have  ready 
access  to  all  the  subroutines  listed.  All  necessary  FORJR 
files  are  available  on  one  8"  CP/M  floppy  disk. 

The  files  MACROS. MAC  and  EQATMO.MAC  do  not  generate  any 
Z-80  code  themselves.  MACROS. MAC  contains  the  macros  used 
in  the  original  ZADJR  system.  This  file  gives  the  user  an 
idea  of  the  original  syntax  for  ZBADJR  and  what  parameters 
each  module  anticipated.  MACROS. MAC  is  not  used  in  FORJR 
and  is  provided  for  informational  purposes  only. 

EQATMO.MAC  contains  constant  definitions  that  are  used 
throughout  the  Z-80  code.  The  values  defined  are  available 


via  the  M80  'EQU'  pseudo-op.  EQATMO.MAC  must  be  present  if 
any  Z-80  modules  are  modified  and  reassembled. 

The  Z-80  files  can  be  modified  using  the  CP/M  editor 
function,  ED.  At  the  begining  of  each  file  is  a  list  of 
changes  made  including  the  date  the  change  was  applied.  In 
addition,  the  comment  field  of  each  change  also  contains  the 
date  the  change  was  applied.  It  is  suggested  that  as  you 
make  changes  to  the  code,  these  dating  procedures  be  adhered 
to  and  updated  accordingly. 

After  the  desired  changes  have  been  applied  to  the 
module,  it  must  be  reassembled.  Certain  switches  are  used 
for  assembling  the  Z-80  modules.  The  command  used  to 
assemble  the  Z-80  code  is: 

M80  ,  r  f il  ename/L /M/ R/ Z 

Where  : 

L  =  Forces  generation  of  a  listing  file,  f il enam e . PR N . 

M  =  Initializes  block  data  areas  to  zero. 

R  =  Forces  generation  of  an  object  file,  filename . REL. 

Z  =  Assembles  Z-80  opcodes. 

Each  of  the  created  files,  .PRN  and  .REL  will  have  the  same 
filename  as  the  .MAC  file. 

3.  LINKING  Z-80  FILES  INTO  THE  F  OR  JR  SYSTEM 

Because  FORJR  must  know  the  location  of  the  Z-80  code, 
the  Z-80  assembly  language  modules  must  be  linked  at  a 
specific  location,  i.e.  9100H.  This  requires  that  special 
instructions  be  applied  when  executing  the  linking  function. 


In  addition,  the  F0RTH/Z-80  interface  program,  BADJR,  must 

be  listed  as  the  first  program  to  be  linked.  Therefore,  the 

command  used  to  link  the  Z-80  code  correctly  is: 

LINK  BADJR [91 00 ], ATRB, BLC  K, BOOL, CONV, IMED, IONS, MATH, 
MIOS, RAD  X, RELN, STOR 

This  will  produce  a  symbol  file  and  an  execution  file 
BADJR. SYM  and  BADJR.COM,  respectively. 

4.  LOADING  A  NEW  FOR  JR  SYSTEM 

The  FORJR  system  is  comprised  of  two  distinct  programs, 
FORTH  and  Z-80  code.  Both  programs  must  be  in  memory 
simultaneously  in  order  to  create  the  new  FORJR  system.  DDT 
is  used  to  load  both  programs. 

To  begin  with,  a  basic  FORTH  system  is  loaded  via  DDT. 
The  current  FORTH  system  used  is  called  HAZEL.COM,  a  FORT'I 
version  for  the  HAZELTINE  1500  CRT.  The  command  to  load 
HAZEL.COM  is: 

DDT  HAZEL.COM 

DDT  will  load  the  FORTH  code  into  low  memory  begining  at 
address  100H. 

After  the  FORTH  code  is  loaded,  the  Z-80  assembly 
languge  module,  BADJR.COM,  that  has  been  linked  as  above 
must  be  loaded  at  address  9100H.  The  DDT  commands  I  (for 
INPUT)  and  R  (for  READ)  are  used.  When  DDf  loads  programs, 
the  loader  offsets  the  load  address  by  100H.  Therefore  you 
must  specify  a  load  address  that  is  1 0  OH  LESS  than  the 
actual  address  desired.  Therefore,  the  commands  for 


inputting  and  reading  BADJR.COM  code  are: 

IB  A  D  JR  .  COM 
R  900  0 

This  will  load  the  Z-80  code  begining  at  9100H. 

After  both  FORTH  and  Z-80  programs  have  been  loaded, 
invoke  the  FORTH  system  via: 

3100 

5.  TESTING  THE  MODIFIED  F  OR  JR  SYSTEM 

When  the  FORTH  system  comes  up  after  G100,  none  of  the 
FORJR  commands  exist  in  the  FORTH  dictionary.  Therefore, 
you  must  change  to  the  BADJR  user  screen  file  via  the  USING 
command : 

USING  BADJSCR 

The  FORJR  dictionary  entries  can  be  loaded  begining  with 
screen  number  nine  via: 

9  LOAD 

When  all  the  BADJR  screens  have  been  loaded,  testing  of  the 
modified  system  can  begin.  If  testing  is  successful,  a  new 
FORJR.COM  file  can  be  created  with  all  the  desired  features 
of  the  new  FORJR  system  in  the  protected  dictionary  space. 

6.  BUILDING  A  NEW  F0RJR.C0M  FILE 

The  whole  FORJR  system  is  closely  tied  to  addresses 
which  implies  that  the  FORTH  dictionary  used  must  be  a 
specific  size.  The  dictionary  size  of  the  basic  FORTH 
system  loaded  as  above  for  testing  must  be  expanded  to 
accomodate  the  necessary  addressing  capabilities.  In  the 
file  F0RTH.SCR,  screen  (?  119  contains  the  necessary  commands 


to  expand  the  dictionary  size.  Change  to  the  FORTH. SCR  file 
via: 

USING  FORTH. SCR 

Load  screen  #  119  via: 

1  1  9  LOAD 

This  will  automatically  execute  the  commands  to  expand  the 
dictionary.  The  program  will  ask  two  questions: 

(1)  Size  of  FORTH  area  (KBYTES): 

To  which  your  response  MUST  be: 

36 

(2)  Enter  //  of  screens  to  buffer: 

To  which  your  response  MUST  be: 

4 

The  program  will  then  expand  the  dictionary  size  to  11977 
bytes,  and  also  execute  a  COLD  which  deletes  all  but  the 
system  dictionary  entries.  You  must  reload  the  FORJR  screen 
contents.  Switch  back  to  the  FORJR  screen  file  via: 

USING  BADJSCR 

Then  reexecute  9  LOAD.  After  the  load  is  complete,  you  have 
to  create  a  new  .COM  file.  Screen  #  3  in  the  BADJSCR  file 
is  used  for  this  purpose.  Execute  this  via: 

3  LOAD 

The  system  will  exit  from  FORTH  back  to  CP/M  and  tell  you  to 
enter  SAVE  94  filename.COM.  However,  in  order  to  establish 
the  correct  file  size,  you  MUST  enter: 

SAVE  128  filename.COM 


This  will  create  a  temporary  file  with  256  records  that  will 
be  used  to  create  a  final  updated  version  of  the  FORJR.COM 
s  yst  em . 

The  new  FORJR.COM  file  is  comprised  of  the  temporary 
file  created  above  combined  with  a  "filler"  file,  BOTOM.COM 
that  is  32  records  long,  and  also  the  BADJR.COM  file  which 
is  125  records  long.  All  three  files  are  copied  into  a 
single  file  via  the  CP/M  Peripheral  Interchange  Program, 
PIP.  The  actual  PIP  command  is: 

PIP  FOR  JR.  COM  =  filename.  COM,  BOTOM.COM,  BAD  JR.  COM 


APPENDIX  B 


FORTH  SCREEN  CONTENTS 

This  appendix  contains  the  FORTH  screens  used  in  FORJR. 
Screens  9  through  26  contain  the  instructions.  Examples  of 
FORJR  programs  are  contained  in  screens  27  through  30. 
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A  1 

A2  -  -  E  DDL 

ANS 

I N 

A3 

t 

9 

SYMBOL  ’  13  ZBADJF  PSTIfvH  ;  < 

Al 

A2  POOL 

A';£ 

IN 

A3 

io 

NUMBER’  14  ZBADJP  PSTINH  i  ( 

Al 

A2  BOOL 

ANS 

IN 

A3 

1 1 

BOOLEAN’  15  ZBADJP  RETINA  ;  < 

Al 

A 2  BOOL 

ANS 

IN 

A  2 

12 

EMFTi’  16  ZBADJF  FSTINA  ;  t 

Al 

A2  BOOL 

AN  5 

IN 

A3 

) 

13 

SEQUENCE’  12  ZBADJP  FBT !NH  :  ( 

Al 

A2  -  - BOOL 

ANS 

I  N 

A3 

J 

14 

1  5  -  - 


Sc-eer  t*  13 

0  (  IMMEDIATE  NUMBER  t  SYMBOL  GENERATOR  1 

1  HEX  F3FTH  DEFINITIONS 

2  100  ALLOT  (  al  locate  tne  string  stsc>  I 

3  HEFE  CONSTANT  40  (  fixed  base  o‘  4ST)  ) 

4  *0  VAPIAELE  4P  (  *F  returns  address  of  var  wit h  SET!  ptr 

5  !  4DF0P  tp  g  DUF  6  +  2+  4P  i  s  (  croc  toe  s trine  ) 

6  i  4g  CUP  >F  $r  B  SWAP  -  SWAP  OVER  F  CMOVE  2  -  F  OVER  1  *P  1  ; 

7  .•  4.  4P  e  CUP  2+  SWAP  6  s  <  STPINCABDR  N  ) 

e  .•  Nut'  4.  15  2BADJP  42F0P  ;  i  CFEATE3  AN  IMMEDIATE  NUMBER  ) 

9  :  STM  *.  16  ZBADJF  4DR0P  ;  (  CPEATES  AN  I MMED i ATE  SYMBOL  ) 

10 
1  1 

12  --> 

12 

14 

15 

Screen.  #  14 

0  (  IMMEDIATE  NUMBER  fr  SYMBOL  CENEP4T0P,  continued  ) 

1  (  PUTS  AN  IMMEDIATE  SYMBOL  INTO  CUPPENT  FRAME  i 

2  :  (  "  )  F:  DUP  2+  SWAP  B  (  moves  in-line  strino  to  4STK.  ) 

3  DUP  2+  F  +  >P  *2  ; 

4  :  if  cotoi  i  ino  emplace  an  in-line  s trine  to  be  ) 

5  (  moved  to  string  stack  at  execution  time,  else  I 

6  (  put  enclosed  strino  on  string  s*ar:k.  ) 

7  22  STATE  B 

£  IF  COMPILE  I")  0  C,  WOFD  HEFE  C2  -1  ALLOT  DUF  .  ALLOT 

9  ELSE  0  C,  WOFD  HERE  C@  -1  ALLOT  HERE  ' 

10  HERE  DUP  2*  SWAP  B  4@ 

11  END IF 

12  STATE  e 

13  IF  COMPILE  SYM 

14  ELSE  SYM  END  I F  ;  IMMEDIATE 

15 


0  I  IMMEDIATE  NUMBEF  f-  BV^EOL  GENERATOR.  csr-nr-JtO 

1  <  PUTS  AN  !  M^ED  1  ATE  NUMFEF  ATTF I  BITE  INTO  FPAf'E  ■ 

2  :  «  (  com  ;  in;  eirr- 1  see  m  in-  >  jr.c  srr:-:  T  cs  • 

3  (  moveo  tc  s  t  •  i  oc  5tsc>  9 1  e> ecu  tic-  time,  e  l  ge  i 

-i  •  put  er.  c  !  cseo  ttfirq  on  str  me  5  t;c-  .  ! 

5  2C  STATE  5 

5  IF  COMPILE  C>  C  C.  WORD  WEPE  C6  -  1  ALL:-  l  UP  .  ALLOT 
ELSE  0  C,  UOFD  AERE  CS  ALLOT  HERE  1 
3  HEFE  DUE  2*  SwAF  5  *6 

9  END  IF 

0  STATE  6 

1  IF  COMPILE  UJ* 

2  ELSE  NUM  E‘J2 1 F  ;  IMMEDIATE 

2  DECIMAL 

5 

Screen  ft  16 

0  (  ATTF  STAC!  b  SEC  MAN ' FULAT1 CN  ROUTINES  ) 

1  i  A!  1  ST!  INA  ;  :  A2  2  ST!  IK'W  ;  :  A?  3  ST!  IN-  ;  :  A4  *1  ST!  IN— 

2  !  A?  5  ST!  IN-  :  :  AS  £  ST!' IN-1  s  :  A7  ?  STL  IN-  ;  :  A£  £  ST!  I N^ 

3  :  A9  9  ST! INW  :  :  A10  10  ST! INn  ;  :  All  ll  ST! I N A  : 

4 

5  (  SEQUENCE  MANIPULATION  ROUTINES  ' 

6  !  S_  23  ZBADJF  :  i  1  Ai  -->  NEWATTF  '  <  IMMEDIATE  SELECT 

7  (  Al  MUST  BE  TOP  ATTF I  BUTE  IN  FFAWE  1 

S  ;  •'<  SETBAS  t  <  BEC-IN  SEQUENCE  CONSTRUCTION  ' 

9  ;  >>  25  2PADJR  ;  t  END  SEQUENCE  CONSTRUCT  I ON  > 

0  :  MEPGE  SETBAS  ;  (  MERGES  SEC  X. . . 1  INTO  EEC  2  : 

1  !  CLSMEP  29  ZEADJF  ;  I  ENDS  MEPGE  OPERATION  ) 

2  -  -  > 

3 

4 

5 

Screen  #  17 

0  i  CONVERSION  $  FFIMITIVE  ROUTINES  > 


1  !  ID 

30 

ZBADJP 

RST I NM  ; 

(  Al 

A2  —  ) 

(  A2 

= 

Al  ' 

2  i  SrMSEG 

33 

ZBADJF 

PST INH  ; 

<  a: 

A2  -  - >  ) 

!  A  2 

IS 

SEQUENCE 

3  :  SEQSYM 

34 

ZBADJP 

PSTINA  ; 

(  Al 

A I  -  -  1  ) 

(  A2 

IS 

S  i'MBOL  ) 

4  s  SEGNUM 

35 

ZBADJP 

RET; NH  ; 

(  Al 

A?  - - >  ! 

<  AZ 

IS 

NUMBER  » 

5  t  NUMSYMi 

36 

ZBADJP 

PST I NH  ; 

<  Al 

A2  i 

!  A2 

IS 

SYMBOL  ) 

6 

7  C  FPIMITIVE  ROUTINES  ) 


8  ( 

Al 

MUST  be 

se  qu  cri 

c e  .  In 

DL 

b  DR, 

A2 

can 

be 

?  r 

v  c  b  j  e  c  t 

9  ( 

In 

SEL  b  SEP,  A 2 

MUST  be 

B 

nurr.e- 

1  c 

a  t  tr  1 

t  j  t  e 

! 

0  : 

RV 

37 

ZBADJP 

FSTINF 

(  Al 

A2 

-  -  > 

A2 

IS 

REV  OF  Al  ' 

1  : 

DL 

38 

ZBADJP 

PST  I NH 

« 

* 

(  Al 

A  2 

A3  - 

-> 

A2 

IS  DL  OVEP  Al 

2  : 

DR 

39 

ZBADJP 

PST  I NH 

(  Al 

A2 

A3  - 

-  > 

A2 

IS  DF  OVEP  Al 

Zi  % 

SEL 

4  0 

ZBADJP 

RST I NH 

! 

(  Al 

A2 

A3  - 

-  > 

A3 

IS  ELT  OF  A: 

4  : 

SEP 

41 

ZBADJF 

RSTINH 

(  Al 

A2 

A3  - 

_  > 

A3 

IS  ELT  OF  Al 

5  --> 


3  c  r  €  e  r<  *  It 


RELATIONAL  OFEFATCPS 
EQT  45  ZEADJF  FST IN- 

(  a: 

m2 

ATS 

IN  AS 

NE^  4 .1  ZE A" JF 

PST  IN'-' 

•  A ; 

A2 

A  ~ 

FOCI 

AN'S 

IN  AS 

L?~  45  ZEADJF 

FST I NH 

v  A2 

A? 

U  ;  -  -  : 

E  0C  2 

AN? 

t  *„ ;  £  -• 

LE"  4c  Z9ADUP 

PSTIN-h 

i  Al 

-2 

A: 

r  : 

AN  9 

irv  a. 2 

GT1-  4-  ZEADJF 

FS~  I  Nim 

(  Ai 

A  2 

L  - 

BO  CL 

AND 

l\  A 

CE-  48  ZEADJF 

FST  IN-* 

•*  Al 

A  2' 

A  2 

FOC  2 

A'. 5 

T  f.  "  C; 

Sc'sen  *  19 

i  AF  I  S1T'-VET  I  C  PF  '  v  I T  I  VES 


I  n 

AD.  SE,  ML.  DV,  ar,c 

MD: 

Al  , 

A  2 

arf  r< €r  : 

I  r 

I NT,  AS,  NO;  At  is 

C  r,'.C-  r 

1  c , 

A  2  i 

£  svrit^esi 

AD 

49  ZEADJF  PST  I NH  ; 

(  Al 

A  2 

A3  - 

-  a  2  -  A! 

SE 

50  ZSADJF  FSTINH  : 

'  A  ] 

AZ 

A3  - 

-  V  A3  =  A ! 

ML 

51  ZEADJF  PST  IN-  : 

■  a; 

AZ 

A  r  - 

-  '  A3  «  A 1 

DV 

DEFLOC  <  AZ  #  0  A4  I- 

EG? 

f  A4  >  QUES 

IF  CP  , “  2EP0  DIVIDE 

FPG 

- 1 EI  TED 

e  •-  :  c  .  j  5  svrtr 


ELSE  52  ZBADJP  END IF  RSTINH  ; 
I  NT  55  ZEADJF  PSTINH  ;  <  Al  AZ  - 
MD  DEFLOC  DEFLOC  DEFLOC  TEFLOC  < 
C  A 2  A4  >  I  NT  <  A 1  AF  A5  5  DV 

<  AS  AS  >  I  NT  ■;  A4  Ac  A~  j  ML 

AE  59  ZEADJF  PST  IMA  ;  (  Ai  A2 

NO  54  ZEADJF  PST I NH  ;  (  Al  A2 


--  A2  =  INTEGEP  CF  Al  » 

(  Ai  A2  AS  --  AS  =  Al  MOD  A 

V 

L  <  Al  AF  AS  SS  FST N~  : 
-->  A2  =  AES'Ai: 

-  - '  A2  =  -  A 1  1 


Screen  *  20 

(  KEYBOARD  INPUT  POUTINE  i 
HEX 

:  SINFUT 

FAD  DUP 

BEGIN  IEY  DUF  OS  = 

IF  SF  2rjp  =  P-  SWAP 

IF  DPOF  0  (  if  Is:  cNar  ,  ignore  ' 

ELSE  EPOP  OE  EMIT  EL  EMIT  08  EMIT  1-  0  END  IF 
ELSE  DUP  Or  = 

IF  DROP  EL  EMIT  1 
ELSE  DUP  EMIT  OVER  O  1+  0  END  I F 
END  IF 
UNTIL 

OVEP  -  *9  ; 

DECIMAL 


Screen  #  21 

0  (  I/O  PRIMITIVE  I/O  ) 

1 

2 

3  :  PRNUM  57  ZBADJR  RSTINH  ; 

4  :  PRSYM  59  ZBADJR  RSTINH  ; 

5  :  PRBUL  6l  ZBADJR  RSTINH  ; 

6  :  RDSYM  GR  INPUT  SYMBOL:  •  $INPUT  SYM 

7 

8 

9  (  MISCELLANEOUS  INSTRUCTIONS  ) 

10  :  POPINH  70  ZBADJR  ; 

11  :  COLECT  71  ZBADJR  ; 

12  :  LENGTH  72  ZBADJR  ; 

13  :  R3TBAS  73  ZBADJR  ; 

14 


0  (  MEMORr  P'UMF  ROUTINES  t  IMTrTOFE  ' 

1  0  VARIABLE  CO'JNTEP 

2  :  D'JMF  CF  HEX  DUF  ...  0  COUNTER  :  SO  0  PC 

3  COUNTER  g  15  '  IF  0  COUNTER  1  PuP  CF  l.  EM  IF 

~  1  COUNTER  *'  CUF  PDF  Cg  SWAP  !*  Cg  1  . F  :  . P  E  RACE  2  -  LOOP 

5  PROP  rECI^AL  : 

6  :  DUMPING  CF  CF  .  S~D*P  C-  FRAME  STACIE  CF  INHSTK  DD^F  : 

7  !  DU«»NOP*  CF  CP  .  "  PUT?  CF  NOSES  '  CP  MODES  PJM-  : 

3  :  DUMnSTF  CF  CF  .  "  DUMP  OF  S~ = I N05FACE  '  CF 

9  STPEFACE  «EX  PL'F  CF  J.  0  COUNTER  '  ’  CO  C  PC 

10  CO-NTFF  g  T  IF  0  COUNTER  '  DUF  CF  U.  EMTF 

11  1  CC-.NTEF  -!  DUF  Cg  3  .  F  :*  PJF  CS  3  .  F 

12  LOOP  PPOF  DECIMAL  CP  ; 

I  3 

M  :  INITSTOPF  95  ZEADUF  EOL  ;  <  INITIALIZE  STORAGE  AREAS  > 

15  -- 

Screen  #  0? 

0  1  A  UTO  FRAME  SETUF  F  PECJPEIVE  SETUP  POUT  I  NEE  ) 

1  (  AUTO  FFAME  SETur  ROUTINE" 

2  0  VAFIAELE  ATTCC-'NT  i  C C.'.TE=  VAFIAELE  F OF  ATTRIBUTES  : 

3  0  VAP'AELE  LOCCOUNT  <  COUNTEF  VAFIAELE  FOP  LOCAL  ATTFJE'JTES  ) 

4  :  <<  0  LOCCOUNT  1  0  ATTCCUNT  ■  ;  IMMEDIATE  (  SETE  COUNTS  TO  0  ) 

5  :  :>;•  ;  (  DUW:  WORD  -  FOR  FEAP1E1LIT)  ONL I  '• 

6  i  < BUILDS  LOCCOUNT  DUF  g  1*  SWAP  ■  (  \%x  =  5 1  N'T  A  ATTP  1 

7  ATTCOUNT  PUP  S  1*  PUP  .  SWAP  '  DOES'-  g  STI  IN-  ; 

is'  I  '  vVy  =  INHEFITEP  ATTF  > 

9  < BUILDS  ATTCOUNT  DUP  g  1*  DUF  .  SWAP  '  DOES,  g  STI  INH  ; 

10  s  DEFLOCS  C  DO  PEFLCC  LOOP  ;  (  SETS  UP  n  SYNTHESIZED  ATTPS  ) 

II  s  LOC  '  LIT  CFA  ,  LOCCOUNT  g  ,  '  DEFLOCS  C FA  .  ;  IMMEDIATE 

12  :  :  i  <  "SEFEPATES  INHEPITEP  ATTRIBUTES  FROM  SYNTHESIZED"  ) 

13  (  FOPTH  RECURSIVE  SETUP  ROUTINES  ) 

14  :  DEFINE  2-  LATEST  FFA  SWAP  '  ;  <  PECUPSIVE  SETUP  ' 

15  J  BADJP  YBUILDS  0  ,  POES'  g  EXWOFD  1  i  <  PECUPSIVE  SETUR  ) 


Semes'-.  *  24 

0  t  SEOUtMCE  INFORMATION  F2  TINES  > 

1  :  OE-AS  FTP  12-5:  --  <i;:=  2r  FA=E  OF  f-FFv-023  FFAM£  • 

2  t  FAS  FT r  14  .  f  .  ■  --  a::f  OF  E-;  E  Or  FFAME  • 

3  :  TOF  FT?  IF  *  5  :  --  ■  7 1 F  7F  ~;F  CF  ^-"E 

4  :  Etc  C£*S  2*  -  2  ■  •">  N~  :  r”A;s  -r  =  a—  rp-v  p?v  pp>. 

2  :  TrP  2-  CB  :  S  ~  '  N  7  A”?  -  T:f£ 

6  :  MXT  ?  ♦  6  ;  t  F'F  : 7  A"-  -  -  ;rrrr-  ';evT  37? 

3  :  LE\  NXT  7  -  ;  =  ”=:*  ~  ‘T  ?  --  FT?! VO  LF’JOT-  > 

9  :  SBLN  OOF  c-F:--  *-7?  .  .  SEQUENCE  LEN'DT-  < 

to  tif  224  =  ;r  lev  : 

1:  else  :f  .  ?-=•;•.-  sec.ence  -  pp:f  end  if  * 

12 

13  :  F:\T'T:P  1  -  4  .  ‘.'TOFF  -  c  7  F  A  —  B  IPX  --  ATTF  Ti'PF  1 

14  C  -  IF  EL.SE  =  1  f  ’  "  ; 

12  »  FIN2IDX  1  -  2  •  FAS  7  -  .  c  ;  ,  F;v  A-?=t.  -  AT”?  UX  >  -- 

Sc'er  *  22 

0  <  st?:n:sfacf  vs:  t  r?-vr  pc.  -i\f  =  1 

1  i  stpaddp  a:  4--  A77-r-=  or  st= : :  on  t;f.  ffsfts  ffame  » 

2  E  AS  2*  B  I  -  4  .  Mf"F5  ♦  g  PET  I Mu  : 

4  s  SECADT  FAS  B  1  -  4  »  N07FS  -  ?  ;  •  --s  ADDP  OF  TOP  SEQ  ) 

2 

6  s  SP  i  M  --  FLT  FPO"  SET  SELECTED  FF7V  p;CHT  OF  SEQ  > 

SEGAD2  3CLN  SWA?  SEQUENCE  van:fjlat!cn  F  OUT  I  WE 

e 

5  s  RDNUM  <  CFEATES  IMMEDIATE  NU^EF’C  ATTP1EUTE  FF^M  1  EYBOAFD  > 

10  CR  . "  INPUT  NUMpEP  '  "  *  INPUT  *»  f  NUM  «  !  >«*  >  ML  » 

1  1 

12  :  SEBLEN  STPADr?  SBLN  ;  '  A1  -  -  LENCT-  OF  SEQUENCE  ) 

1  3 

14 

12 

Screen  *  2f 

0  (  FPAME  PRINTOUT  ROUTINE  ' 

1  HEX  0  VAF I AELE  ATT* 

2  :  ATTSTK  C  ATT#  5  ST).  I V-  J  ; 

3  :  PPINT1T 


4 

DUP 

Cl  = 

IF 

. "  NEC  NOMEEP 

..  ATTSTt 

PPNUM 

ENDIF 

5 

DUF 

C2  = 

IF 

, "  POS  NUMBER 

••  ATTSTK 

PPNUW 

END  IF 

S 

DUP 

DO  = 

IF 

. "  SYMBOL  "  CP 

ATTSTK 

PPSYM 

CP  ENDIF 

7 

EO  = 

IF 

.  "  SEQUENCE  " 

CR  ATTST) 

SEBLE 

\ 

8 

.  “  LENGTH  =  •' 

.  CP  END  I F  ; 

9  !  FRAME  f  PRINTS  CUFPENT  FPAME  ADPF  fe  ATTRIBUTES  ) 

10  HEX  TOP  EA5  DUP  CP  CP  . "  FPAME  ADDR*  "  U.  CF  CR  2+  2DUP  = 

11  IF  CP  FRAME  EMFTY  “  DPOF  PPOP  ELSE  -2/1* 

12  1  DO  I  DUF  ATT*  1  FINDIDX  FINBTYP 

13  DECIMAL  .  "  ATTP  #  -  I  .  HEX 

14  0-  IF  . "  NOT  DEFINED  "  CP 

12  ELSE  PRINT IT  END IF  LOOP  END  IF  CF  DECIMAL  ; 


DEC  I mal 


T-E  FOLLOWING  SCREENS  APE  SAMPLE  FPCGPAMS  FOP  FOPJ? 

FACTOR  IS  A  Ft  CUPS  I  v'E  FACTOFIAL  PFOGFAM 

TC  US  FACTOR.  LOAF  SCREEN  2~  FROM  FAPJSCF.SC?  VIA; 

2F  LOAF 

THEN  TlFE; 

F ACTOF 


t 


BAG 

.  i 


FFOGFAM 
E  C 


€  £  "1  #  ^  7 

ECuFSIVF  FACTOFIAL 
'■  X  '  !  “  Z  '•  A  ' 

JP  FACT 

I  ME!  :  '  FACT  DEFINE  2  (  FEDEFINES  LINE!  AS  FACT 

LG!  <  DEFINES  LOCAL  ATT? I EUTES  ' 


C  i  *  I 
IF  <  *  i 
ELSE 


A  >  LE 


X 


F"  C  A 
ML 


G’JES 


SE 

ML 

FACT 


12 

13 

14 

15 
OF 


EM)  IF 
EOL  ; 

rACTOP  CP  MAXIMUM  INPUT  =  EC  " 
INITSTORE  <  DEFLOC  I  <  #  1  PDNJM 
,  -  ANSWER  =  "  {  X  }  PPNUM  EOL  ; 


CP 
I  X 


FACT  CF 


TW/.'av.v.v.a'.-,'.-..-.  ■  v. . .  •  . 


50S  :s  A  PUNNING  BUM  OF  SQUARES  F  j1" 


TO  USE  SOS,  LOAD  SCREEN  30  FFOM  EADZSCF.SC0  VIA; 
3C  LOAD 

THEN  T)FE: 

SOS 


SOS  POMS  UNTIL  THE  NHJMEEF  ZEPO  IS  ENTERED 


Scree.-.  »  30 

0  (  INTERACTIVE  SJM  OF  SO  JAPES  PFOCFAM  ) 

1  CC  *  V  '  W  ■"  X  r  >>  1  SET  Ur  ATTRIBUTE  NAMES  . 

2  (  X  .  X  .  Z  APE  LOCAL  ft-P,  i 

3  :  SOS 

4  CF  . "  ENTER  DESIRED  NUMFEP.  PROGRAM  ENDS  WHEN  ZEPO  ENTERED 

5  CP  I N I TSTOPE  {  I  0  ! 

E  BEGIN  RDNJM  LOC  <  DEFINE  3  LOCAL  VAojAPLES  ) 

7  i  W  W  :  X  >  ML 

8  OF  ,  '•  INFUT  NUMBER  SQUARED  =  ”  CP  {  X  I  PPNU1' 

s  (  v  x  :  r  ;  a; 

10  CP  .  ■  PUNNING  TOTAL  «  *  CP  {  X  >  FPMUM 

11  I  W  *  O  !  2  >  ED' 

12  C  Z  >  SUES 

13  IF  1  (  QUIT  ) 

14  ELSE  C  Y  >  SLIDE  0  (  DO  NOT  QUIT  )  END I F 

15  UNTIL  ! 


APPENDIX  C 


Z-80  SOURCE  LISTINGS 

This  appendix  contains  the  source  listings  of  the  Z-80 
modules  used  in  FORJR.  Table  C.1  provides  a  short 
description  of  the  responsibilities  of  each  module. 


TABLE  C.  1 


Z -80  SOURCE 

CODE  tILES  AND 

MAJOR  SUBROUTINES 

BAD  JR 

:  FORTH/Z80  Interface  Program 

and  Jump 

Table 

ATRB : 

Attribute  Frame  Management 

SETINH 

STKINH 

RSTINH 

DEFLOC 

QUES 

RSTBAS 

PS  HI NH 

PO  PI  NH 

SETBAS 

BLCK: 

Storage  Ini 

tialization,  Storage  Areas 

INITSTOR 

SA VREG 

RSTREG 

BOOL: 

Logical  Oper 

ations,  Predicates 

BAND 

BOR 

BXOR 

BNOT 

ATOM? 

NIL? 

SYMBOL? 

NUMBER? 

BOOLEAN? 

EMPTY? 

SEQUENCE? 

CONV: 

Conversions  , 

Sequence  Manipulations 

ID 

SYMSEQ 

SEQNUM 

NUMSYM 

R  V 

TR 

DL 

DR 

SEL 

SER 

IMED: 

Immediate  In 

structions 

NUM 

SYM 

SL 

LN 

CONS 

MERGE 

IONS: 

In  put/Output 

In  str  uc  tions 

PR  NUM 

PRS  YM 

PRBUL 

MATH: 

Arithmetic  Instructions 

AD 

SB 

ML 

DV 

NG 

ABS 

RAD  X: 

Rad  ix  Conversion 

BC  DA  SC 

ASCBCD 

HEXASC 

ASCHEX 

HEXBCD 

BCDHEX 

TABLE  Cl  (CONTINUED) 


RELN:  Relational  Instructions 

EQ?  NE?  LT? 

GT?  GE? 

STOR:  Storage  Management 

SLIDE  COLECT  GC 

FETCH  GETNOD 

MACROS:  Macro  File  Used  In  Original  Zbadjr 


LE? 


ALLOC 


EQATMO:  Equate  File  Defining  Constants 


31 

OCT 

83  - 

22 

NOV 

83  - 

28 

NOV 

83  - 

13 

DFC 

83  - 

14 

DEC 

83  - 

06 

JAN 

84  - 

13 

JAN 

84  - 

TITLE 


ORIGINAL 
ADDED  LENIMM 

INSTALLED  REFERENCES  TO  STORAGE  AREAS 
ADDED  STORAGE  AREAS  FOR  FORTH  I/O 
BEGAN  REMOVING  DEAD  WOOD  STORAGE 
INSTALLED  RSTBAS  IN  JUMPTABLE 
REMOVED  TR 

BA D JR  A/O  13  JAN  84 


EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 

EXTERNAL 


AB, AD, ATOM? 

BA ND, B NOT, BOOLEAN?, BOR, BXOR 

COLECT, CONIMM 

DEFLOC, DL, DR , D  V 

EMPTY?, EQ 

FORRST, FORSA  V 

GE  ,  GT 

ID,  INITST,  INPBUF 
INT 
LE,  LT 
MERIMM, ML 

NE, NG, NIL?, NUMBER? .NUMIMM, NUMSYM 
POPINH,  PRBUL,  PRNUM,  PRSYM,  PSHINH 
QUES 

RSTBAS, RSTINH, RSTREG, RV 

SAVREG,  SB,  SEL,  SEL IMM  ,  SE  QN  UM  ,  SE  QS  YM,  SEQUENCE?  ,  SER 
SETB  AS,  SETINH,  SLIDE,  ST  KI  NH  ,  LE  N IM  M 
SYMBOL?  ,SYM  IMM,  SYMSEQ 


EXTERNAL  PT R , HDR , INHST K, NODLST, NODES 

GLOBAL  BTTABLE.FORRTN, PRFLAG, PRADDR , PR N UMB , B DOSF LG 

GLOBAL  BADENTRY 


MACLIB  EQATMO 
EQUATES 


.«»»*«»»•*»»****•»»•»•»**»•**•*»»*** 

;  THIS  IS  THE  ROUTINE  TO  INTERFACE 
;  FORTH  WITH  THE  Z-80  ZBADJR  ROUTINES 

.*»«*•»»*»*«»*»»*»•**»*»»»»»**»«*«» 

» 

« 

.  SALL 
BADENTRY: 

JP  STRT  ;  JUMP  AROUND  STORAGE  AREAS 

t 

.»*#«»##*»»*»»*#»»*»*#»*#**»»*#**###»*«*#»##» 

;  REFERENCES  TO  MEMORY  STORAGE  AREAS 

'*»«»**»»»»»*«*»«*»**»•*»»*•»**»»***«»**»*»»* 


DW 

DW 


PT  R 
HDR 


ADDRESS  OF  POINTER 
ADDRESS  OF  HEADER 


DW 

INHSTK 

ADDRESS  OF  INHERITANCE  ST 

DW 

NODLST 

ADDRESS  OF  NODELIST 

DW 

NODES 

ADDRESS  OF  STRINGSPACE 

DW 

PR  FLAG 

ADDRESS  OF  PRINT  REQUEST 

DW 

PRADDR 

ADDRESS  OF  BEGINNING  OF 

DW 

PRNUMB 

A  DDR  OF  it  OF  BYTES  TO  PR 

DW 

• 

BDOSFLG 

ADDR  OF  SYSTEM  PRINTOUT 

;  SAVE  FORTH 

ENVIRONMENT 

STRT :  CALL 

FORSAVE 

SAVE  FORTH  REGISTERS 

LD 

HL,  0 

: 

LD 

(PRFLAG) ,HL 

ZERO  OUT  PRINT  FLAG 

POP 

DE 

SAVE  RETURN  ADDRESS  TO  F 

LD 

( FOR  RTN ) , DE 

SAVE  FORTH  RETURN  ADDRES 

POP 

HL 

GET 

INDEX  INTO  JUMP  TAB L 

;  SET  INDEX 

INTO  JUMPTABLE 

LD 

DE .BTTABLE 

ADD 

HL,  DE 

LD 

DE, RETADD 

PUSH 

DE 

JP 

(HL) 

RETADD: 

LD 

DE, ( FOR  RTN  ) 

RESTORE  FORTH  RETURN  ADD 

PUSH 

DE 

CALL 

FORRST 

RESTORE  FORTH  REGISTERS 

RET 

;  JUMP  TABLE 

FOR  ZBADJD  ROUTINES 

BTTABLE : 

;  FRAME  MANIPULATION  ROUTINES 

9 

JP 

SETINH 

0. 

SETS  A  NEW  BAS,  OBAS 

JP 

STKINH 

1. 

STACKS  ATTRIBUTES  ONT 

JP 

RSTINH 

2. 

RESETS  BAS,  OBAS  TO  P 

JP 

SETBAS 

3. 

SETS  NEW  BAS 

JP 

DEFLOC 

4. 

(  it  —  >  )  DEFINES  LO 

JP 

QUES 

5. 

DETERMINES  STATUS  OF 

JP 

SLIDE 

6. 

SLIDES  CURRENT  FRAME 

LOGICAL  OPERATORS 


• 

9 

JP 

BAND 

;  7. 

BOOLEAN  "AND" 

JP 

BOR 

;  8. 

BOOLEAN  "OR" 

JP 

BXOR 

;  9. 

BOOLEAN  " X 0 R " 

JP 

BNOT 

;  10. 

BOOLEAN  "NOT" 

9 


CHARACTERISTIC  FUNCTIONS 


JP 

ATOM? 

11.  IS  OBJECT  AN  ATOM? 

JP 

NIL? 

12.  CHECKS  FOR  NIL  SEQUEN 

JP 

SYMBOL? 

13.  IS  ATTRIBUTE  A  SYMBOL 

JP 

NUMBER? 

14.  IS  ATTR IBUTE  A  NUMBE 

JP 

BOOLEAN? 

15.  IS  ATTRIBUTE  BOOLEAN 

JP 

EMPTY? 

16.  CHECKS  FOR  EMPTY  S  YM 

JP 

SEQUENCE? 

17.  CHECKS  FOR  SEQUENCE 

FINITE? 

:  JP 

EXIT 

18.  RESERVED  FOR  FINITE? 

STREAM? 

:  JP 

EXIT 

19.  RESERVED  FOR  STREAM? 

DRY?  : 

JP 

EXIT 

20.  RESERVED  FOR  DRY? 

;  ATTRIBUTE 

BUILDING  ROUTINES 

9 

JP 

NUM IMM 

21.  MAKES  A  NUMERIC  ATTR 

JP 

S YM IMM 

22.  MAKES  A  SYMBOLIC  ATT 

JP 

SELIMM 

23.  IMMED.  SEL  FROM  A  SE 

JP 

SELIMM 

24.  IMMED.  SER  FROM  A  SE 

JP 

CONIMM 

25.  ENDS  SEQ  CONSTRUCTOR 

CATIMM: 

JP 

EXIT 

26.  RESERVED  FOR  CATIMM 

HEAD: 

JP 

EXIT 

27.  RESERVED  FOR  HEAD 

TAIL: 

JP 

EXIT 

28.  RESERVED  FOR  HEAD 

JP 

MERIMM 

29.  ENDS  SEQ  MERGE  FUNCT 

;  CONVERSION 

ROUTINES 

9 

JP 

ID 

30.  MAKES  AND  IDENTICAL 

SEQSTR: 

JP 

EXIT 

31.  RESERVED  FOR  SEQSTR 

STRSEQ: 

JP 

EXIT 

32.  RESERVED  FOR  STRSEQ 

JP 

SYMSEQ 

33.  MAKES  A  SEQ  FROM  A 

JP 

SEQS  YM 

34.  MAKES  A  SYMBOL  FROM 

JP 

SEQNUM 

35.  MAKES  A  NUMBER  FROM 

JP 

NUMSYM 

36.  MAKES  A  SYMBOL  FROM 

;  SEQUENCE  MANIPULATION  ROUTINES 

9 

JP 

RV 

37.  MAKES  A  REVERSE  SEQU 

JP 

DL 

38.  DIST.  LEFT  OVER  A  SE 

JP 

DR 

39.  DIST.  RIGHT  OVER  A  S 

JP 

SEL 

40.  DOES  PRIM  SELECT  FRO 

JP 

SER 

41.  DOES  PRIM  SELECT  FROM 

TR: 

JP 

EXIT 

42.  RESERVED  FOR  TR 

;  IN  THE  FOLLOWING  FUNCTIONS,  A3 

IS  RETURNED  AS  A  BOOLEAN 

;  DEPENDING 

UPON  THE  RESULT  OF  THE  COMPARISON  OF  A1  AND  A2 

9 

JP 

EQ 

43.  CHECKS  IF  A 1  =  A2 

JP 

NE 

44.  CHECKS  IF  A1  /=  A2 

JP 

LT 

45.  CHECKS  IF  A1  <  A2 

JP 

LE 

46.  CHECKS  IF  A1  <=  A2 

JP 

GT 

47.  CHECKS  IF  A1  >  A2 

JP 

GE 

48.  CHECKS  IF  A 1  >=  A2 

ARITHMETIC  FUNCTIONS 
IN  THE  FOLLOWING  Z BA D JR  FUNCTIONS,  A3  IS  RETURNED  AS  A 
ATTRIBUTE  WITH  THE  RESULT  OF  THE  ARITHMETIC  OPERATION 


JP 

AD 

49 .  A3  =  A1  +  A2 

JP 

SB 

50.  A3  =  A1  -  A 2 

JP 

ML 

51 .  A3  =  A  1  «  A2 

JP 

DV 

52.  A3  =  A1  /  A 2 

JP 

AB 

53.  A2  =  !  A 1  !  (  ABSOLU 

JP 

NG 

54.  A2  =  -  A 1  (  NEGATION 

JP 

INT 

55.  A2  =  INTEGER  VALUE  0 

;  I/O  FUNCTIONS 

RDNUM  : 

JP 

EXIT 

56.  RESERVED  FOR  RDNUM 

JP 

PRNUM 

57.  PRINTS  INTEGER  VALUE 

R  DS  YM  : 

JP 

EXIT 

58.  RESERVED  FOR  R  DS  YM 

JP 

PRS  YM 

59.  PRINTS  SYMBOL  FROM  A 

RDBUL: 

JP 

EXIT 

60.  RESERVED  FOR  RDBUL 

JP 

PRBUL 

61.  PRINTS  TRUE/FALSE  OF 

;  HIGHER 
• 

LEVEL 

FUNCTIONS 

WHILE  1: 

JP 

EXIT 

62.  RESERVED  FOR  WHILE  1 

WHILE  2: 

JP 

EXIT 

63.  RESERVED  FOR  WHILE2 

A  PPL Y  1  s 

JP 

EXIT 

64.  RESERVED  FOR  APPLY  1 

A  P  PLY  2: 

JP 

EXIT 

65.  RESERVED  FOR  APPLY 2 

STKWLD: 

JP 

EXIT 

66.  RESERVED  FOR  SKTWLD 

INSERT: 

JP 

EXIT 

67.  RESERVED  FOR  INSERT 

IOSEL: 

JP 

EXIT 

68.  RESERVED  FOR  INSERT 

;  MISCELLANEOUS 

COMMANDS 

f 

JP 

IN ITSTORE 

69.  INITIALIZE  STORAGE  A 

JP 

POPINH 

70.  REMOVES  TOP  ATTR  FRO 

JP 

COLECT 

71.  COMPACTS  STRING  AND 

JP 

LENIMM 

72.  RETURNS  LENGTH  OF  SE 

JP 

RSTBAS 

73.  RESETS  BAS 

EXIT: 

RET 

USED  FOR  RESERVED  ROUTIN 

FORRTN: 

DW 

1 

PRFLAG: 

DW 

1 

12/13  PRINT  FLAG 

PRADDR : 

DW 

1 

12/13  START  OF  PRINT  ADD 

PR  NUMB : 

DW 

1 

12/13  //  OF  BYTES  TO  PRIN 

BDOSFLG: 

DW 

0 

12/15  FLAG  FOR  BDOS  CALL 

;  6  OCT  83 

;  28  OCT  83  -  CHANGED  STKINH  (POP  BC) 

;  23  NOV  83  -  CHANGED  QUES  TO  SUPPORT  FORTH 

;  14  DEC  83  -  REMOVED  ALL  EXTRANEOUS  INSTR UC TI ONS/ STOR A GE 

• 

TITLE  ATRB  A/O  14  DEC  83 

; R  OUT  I NE  S  TO  HANDLE  INHERITED  ATTRIBUTE  STACK 
;AND  TO  PASS  ATTRIBUTES  TO  BAD  JR  FUNCTIONS 
; A  LSO  INCLUDES  "QUES"  THE  CONDITIONAL  LINE 
{ROUTINE 

.  Z80 
.  SALL 

;  GLOBAL  TATRB 

GLOBAL  SETINH, STKINH, RSTINH.DEFLOC 

GLOBAL  SETBAS, RSTBAS 

GLOBAL  INH. 1, INH. 2, INH. 3 

GLOBAL  INH. 4 

GLOBAL  PSHINH, POPINH 

GLOBAL  GETATR, ALOSYN,  ATR 

GLOBAL  QUES 

• 

9 

• 

EXTERNAL  HDR, PT R , FETC H , ALLOC , GE T NOD 
EXTERNAL  SAVREG,  RSTRE  G,  STLUP  1 ,  LUP  1 
EXTERNAL  PR  LINE 

.XL  1ST 

MACLIB  EQATMO 
EQUATES 

.  LIST 


SETINH: 

INH.  1 : 

{SETS  A  NEW  BOTTOM  FOR  INHSTK  WHEN  A  LINE  IS  DEFINED 
CALL  SAVREG 

LD  HL, ( BAS+PTR )  ;SAVE  OLD  ( BAS+PTR  ) 

LD  (OBAS+PTR) , HL 

LD  DE , ( PT R  +T 0 P )  ;NEW  BAS=OLD  TOP 

LD  (  PTR  +BAS  )  ,  DE 

LD  HL , PT R  +OB AS  {PUSH  OLD  BAS 

LDI 

LD  I 

LD  (TOP+PTR) ,DE 
CALL  RSTRE G 
RET 


STKINH 


INH.  2: 

; STACKS  UP  ONE  MORE  INDEX  FROM  CALLER'S  LIST 
CALL  SAVREG 

POP  HL  ;  SAVE  RETURN  ADDRESS 

POP  BC 

PUSH  HL  ;  RESTORE  RETURN  ADDRESS 

LD  I  X, (OBAS+PTR ) 

LD  IY, ( TOP+PTR ) 

ADD  IX, BC  ;GE T  IDX  FROM  OLD  STK 

ADD  IX, BC 

LD  C,(IX)  ; S A VE  THE  IDX 

LD  B , ( IX  +1 ) 

LD  ( I Y  )  ,  C 
LD  ( I Y  +1 )  ,  B 
INC  IY 
INC  IY 

LD  (TOP+PTR ) , IY  ;RESET  TOP 

CALL  RSTREG 

RET 


RSTINH: 

INH. 3: 

; S ETS  BOTTOM  BACK  TO  CALLER'S  BOTTOM 
CALL  SAVREG 
LD  HL , ( BAS+PT R  ) 

LD  (TOP+PTR), HL 
LD  DE , BAS+PTR 
LD  I 
LD  I 

LD  HL , ( BAS+PTR ) 

LD  DE, OBAS+PTR 

LDI 

LD  I 

CALL  RSTREG 
RET 


SETBAS: 

; SETS  NEW  BAS  WITHOUT  SETTING  NEW  OBAS 
CALL  SAVREG 
LD  DE, (TOP+PTR) 

LD  HL, BAS+PTR 

LDI 

LDI 

LD  (TOP+PTR), DE 
DEC  DE 
DEC  DE 

LD  (BAS+PTR), DE 
CALL  RSTREG 


R  STB  AS : 

; R  ESETS  BAS  TO  PREVIOUS  VALUE 
CALL  SAVREG 
LD  HL,(BAS+PTR) 

LD  (TOP+PTR ) , HL 
LD  DE , BAS+PTR 
LD  I 
LDI 

CALL  RSTREG 
RET 


DEFLOC  : 

INH. 4: 

; PUSHES  A  NEW  LOCAL  INDEX  ONTO  STACK 
CALL  SAVREG 
LD  DE, (TOP+PTR ) 

CALL  GETNOD  ;GET  A  NEW  NODE  INDES 

LD  HL,  IDX+HDR  ;(HDR+IDX)  HOLDS  INDEX 
LDI 

LDI  ; (DE ) <-I NDE  X 

LD  (TOP+PTR), DE 
CALL  RSTREG 
RET 


PSHINH : 

CALL  SAVREG 
LD  DE, (TOP+PTR) 
LD  HL,  IDX+HDR 
LDI 
LDI 

LD  (TOP+PTR), DE 
CALL  RSTREG 
RET 


POPINH: 

CALL  SAVREG 
LD  IX, (TOP  +  PTR) 
DEC  IX 
DEC  IX 

LD  (TOP+PTR), IX 
CALL  RSTREG 
RE 


GETATR : 

{UNSTACKS  (NINH)  INHERITED  AND  (NSYN) 
{SYNTHESIZED  ATTRIBUTES  FROM  INHSTK 
{FETCHES  THE  INHER.  ATTR.  AND  DEFINES  DESCRIPTOR 
{BLOCKS  FOR  EACH  IN  ATRBLK.  STORES  SYN.  ATTR. 
{INDICES  IN  ATRBLK.  GIVES  THE  ADDRS  OF  THE 
;DESC.  BLKS.  TO  CALLER  IN  (DESC) 

CALL  SAVREG 
LD  IX.ATRLST 
LD  IY, (DESC+ATR ) 

LD  H  L ,  ( BAS  +  PTR ) 

INC  HL 
INC  HL 

; H L  =1  NHSTK,  IX=LST  OF  DESC  BLKS 
{THIS  LOOP  UNSTACKS  THE  INHER.  ATTR. 

LD  BC, ( N I NH  +ATR ) 

CALL  STLUP1 
GA. 1:  CALL  LUP1 

JP  M.GA.2 
LD  DE,  IDX+HDR 
LDI 
LDI 

{FETCH  THE  INHER.  ATTR. 

CALL  FETCH 
{COPY  HDR  TO  ATRBLK 
LD  (TEMP) , HL 
LD  HL,  IDX+HDR 
LD  E  ,  (IX  ) 

LD  D, ( I X+1 ) 

{COPY  TO  CALLERS  LOCAL  LIST 
LD  (IY)  ,E 
LD  (IY+1),D 

{COPY  ENTIRE  HDR  BLK  TO  ATRBLK 
LD  BC,  1  1 
LDIR 

LD  HL , ( T  EM  P ) 

LD  BC , 2 
ADD  IX, BC 
ADD  I Y , B C 
JP  GA.  1 

GA.  2: 

{THIS  LOOP  JUST  STORES  THE  SYN  ATTR  INDICES 
LD  BC, (NSYN+ATR) 

CALL  STLUP1 
GA. 3s  CALL  LUP  1 
JP  M, GA. 4 
LD  E  ,  (IX ) 

LD  D, ( I X  +  1  ) 

{COPY  TO  CALLERS  LOCAL  LIST 
LD  ( I Y ) , E 
LD  ( I Y  +  1 )  ,  D 


{COPY 


GA.  4: 


INDEX  TO  ATRBLK 
LDI 
LDI 

LD  BC , 2 
ADD  IX, BC 
ADD  IY.BC 
JP  GA. 3 

CALL  RSTREG 
RET 


{MOVE 


ALOSYN: 

{ALLOCATES  THE  INHERITED  ATTR.,  USING 

{ ID  X,  TYP  AND  SPC  IN  ATRBLK 
CALL  SAVREG 

{MOVE  UP  TO  FIRST  SYN.  ATTR.  IN  ATRLST 
LD  IX, ATRLST 
LD  BC, (NINH+ATR ) 

ADD  IX, BC 
ADD  IX, BC 
LD  BC,  (NSYN+ATR) 

CALL  STLUP1 

AS.  1 :  CALL  L UP  1 

JP  M, AS. 2 
LD  L , ( IX ) 

LD  H , ( I X  +  1  ) 

{COPY  IDX,TYP,SPC  TO  H DR  BLK 
LD  DE  ,  IDX+H DR 
LD  BC, 5 
LDIR 

{ALLOCATE  THE  NODE  WITH  THIS  INFO 
CALL  ALLOC 

{NOW  COPY  ADR ,  FST,  LST  INTO  ATRBLK 
EX  DE, HL 
LD  BC, 6 
LDIR 

{REPEAT  FOR  OTHER  SYN  ATTR. 

INC  IX 
INC  IX 
JP  AS. 1 

AS. 2:  CALL  RSTREG 

RET 


AS.  1 


{COPY 


AS.  2: 


QUES: 


CHANGED  TO  SUPPORT  FORTH 


FETCHES  VALUE  OF  A  BOOLEAN  NODE,  B 
DISINHERITS  B  FROM  STACK 
RETURNS  A  ONE  ON  THE  FORTH  STACK  IF  B=T 
RETURNS  A  ZERO  ON  THE  FORTH  STACK  IF  B  =FA LSE 


•  •"** 


SAVE  RETURNS  ADDRESS 


POP 

DE 

CALL 

GETX 

CALL 

CH  KB UL 

CALL 

INH.  3 

LD 

IX,  (  FST+XX ) 

LD 

A,  (IX) 

C  P 

FALSE 

JP 

NZ, QS  1.  1 

LD 

BC,  0 

JP 

QS  1. 2 

QS  1 .  1 : 

LD 

BC,  1 

QS  1. 2: 

PUSH 

BC 

• 

» 

PUSH 

RET 

DE 

• 

f 

CHKBUL: 

{CHECKS 

THAT 

XX  IS  A  BOOLN  NODE 

LD  A, 

(TYP+XX  ) 

CP  BOOLN 

RET  Z 
LD  DE 

,  $C  HKB  L 

CALL 

PR  LI NE 

RET 

$CHKBL: 

• 

f 

DB  ’TRYING  "QUES”  ON  NON 

;  ENSURE  BOOLEAN  VALUE 


CHECK  VALUE 

=  >  B  IS  TRUE 

0  IS  FALSE  IN  FORTH 

1  IS  TRUE  IN  FORTH 
ANSWER  FROM  QUES  1 
RESTORE  RETURN  ADDRESS 


>  I  )  I  I  f  f  (  f  >  I  t  t  I  I  >  t  I  I  t  I  I  I  I  I  I  M  I  I  I 


GETX: 


CALL  SAVREG 
LD  BC, 1 

LD  (NINH+ATR ) ,BC 
LD  BC,0 

LD  (NSYN+ATR  )  ,BC 
LD  BC , XAT R 
LD  (DESC+ATR  )  ,BC 
CALL  GETATR 
LD  DE , XX 
LD  H  L , ( XATR  ) 

LD  BC,  1 1 
LDIR 

CALL  RSTREG 


ATRLST:  DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 
DW 

ATRBLK:  DS 
END 

•END  OF  ATRB  AND 


ATRBLK 

ATRBLK+1 *BLKS IZ 
ATRBLK +2  *BLKSIZ 
ATRBLK+3  »BLKSIZ 
ATRBLK+4*BLKSIZ 
ATRBLK+5  »BLKSIZ 
ATRBLK+6*BLKSIZ 
ATRBLK+7  *BLKSIZ 
ATRBLK+8*BLKSIZ 
ATRBLK-t-9  *BLKSIZ 
1  0*  BL  KS  IZ 


COND 


;  31  JUL  83  -  ORIGINAL 
;  25  OCT  83  -  CHANGED  ASCII  TO  DS 

{  14  DEC  83  -  REMOVED  ALL  EXTRANEOUS  STORAGE,  ADDED  ZERO  0 

• 

* 

TITLE  BLCK  A/O  14  DEC  83 

;THE  BLCK  OF  STORAGE  AREAS  FOR  BAD  JR 
« 

GLOBAL  INITSTOR 

GLOBAL  PTR, HDR , NODLST, NODES, INHSTK 
GLOBAL  SAVREG,  RSTREG,FORSAV,FORRST 
GLOBAL  STLUP1, LUP1, STLUP2, LUP2, STLUP3,  LU P 3 

.  XL  1ST 

MACLIB  EQATMO 
EQUATES 

.  LIST 


INITSTOR  : 

{INITIALIZES  NODE  LIST,  NODE  SPACE  PTRS, 
{INHSTK  PTRS,  AND  STACK 
{  !!!!!!!!!!!!!  NOTE  !!!!!!!!!!! 

{CALL  INITSTOR  ONLY  ONCE  !!!!!!! 
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 

,-SET  STACK  PTR  FOR  SAVING  REGISTERS 

LD  HL, REGSTK 
LD  (REGTOS).HL 
CALL  SAVREG 
LD  HL, NODES 
LD  ( BASE+PTR ) , HL 
LD  (FREE  +  PTR ) , HL 
LD  BC, MAXSTOR 
ADD  H L , BC 
LD  (LAST+PTR ) , HL 

{  ZERO  OUT  INHSTK 


LD 

HL,  INHSTK 

LD 

DE, INHSTK 

INC 

DE 

LD 

(HL)  ,  0 

LD 

BC, 200H 

DEC 

LDIR 

BC 

ZERO  OUT  STRING  SPACE 

LD  HL, NODES 
LD  DE, NODES 


INC  DE 
LD  (HL  )  ,  0 
LD  BC.MAXSTOR 
DEC  BC 
LDIR 

{MARK  ALL  NODES  AVAIL  IN  NODLST 
LD  HL, NODLST 
LD  (HL) , NILIDX 
INC  HL 

LD  (HL), NILIDX 
INC  HL 
LD  (H  L  )  ,  0 
INC  HL 
LD  (HL  )  , 0 
INC  HL 
EX  DE,  HL 
LD  HL, NODLST 
LD  BC, NUMNOD 
DEC  BC 

;  MULTIPLY  BC  BY  4 
SLA  C 
RL  B 
SLA  C 
RL  B 
LDIR 

» 

{INITIALIZE  POINTERS  TO  INHSTK 

IS. 2:  LD  HL, INHSTK 

LD  ( BAS+PTR ) , HL 
INC  HL 
INC  HL 

LD  (TO  P+PT  R ) , HL 
CALL  RSTREG 
RET 


;  ROUTINES  TO  SAVE  FORTH  REGISTERS 
FORSAV: 


LD 

(BCSAV) ,BC 

LD 

(DESAV) , DE 

LD 

(HLSAV) , HL 

LD 

(I XSAV)  ,  I X 

LD 

(IYSAV) ,  IY 

RET 

FORRST: 


LD 

IY,  (IYSAV) 

LD 

IX,  (IXSAV) 

LD 

HL, (HLSAV) 

LD 

DE, (DESAV) 

LD 

BC, ( BCSAV) 

RET 

SAVREG: 

;SAVES  ALL  REGISTERS  HERE 
LD  (TEMP ) ,  S  P 
LD  SP.(REGTOS) 

PUSH  BC 
PUSH  DE 
PUSH  HL 
PUSH  IX 
PUSH  IY 

LD  (REGTOS).SP 
LD  S  P,  (TEMP  ) 

RET 

RSTREG: 

{RESTORES  ALL  REGISTERS  FROM  REGBLK 
LD  (TEMP) , S  P 
LD  S  P,  (  R  EGTOS  ) 

POP  IY 
POP  IX 
POP  HL 
POP  DE 
POP  BC 

LD  (R  EGTOS ) , SP 
LD  S  P, (TEMP ) 

RET 


«*»»*»»» 

{SET  A  DOLOOP  COUNTm;  TO  BC 
STLUP  1 ; 

LD  ( CLU P 1 ) , BC 
RET 

STLUP2: 

LD  ( CLU  P  2 ) , BC 
RET 

STLUP3: 

LD  (CLUP3),BC 
RET 

•EACH  OF  THESE  DECREMENTS  LOOP  COUNTER  BY  1 
LUP  1 : 

LD  (TEMP)  ,  BC 
LD  BC  ,  ( C  LUP 1 ) 

DEC  C 

JP  P.LUP11 
DEC  B 

LUP 1 1 :  LD  ( CLUP 1 ) , BC 
LD  BC.(TEMP) 
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RET 

LUP2: 

LD 

(TEMP)  ,BC 

LD 

BC ,(CLUP2) 

DEC 

C 

JP 

P, LUP22 

DEC 

B 

LUP22: 

LD 

( CLUP2) , BC 

LD 

BC , (TEMP) 

RET 

LUP3: 

LD 

(TEMP)  ,  BC 

LD 

BC ,(CLUP3) 

DEC 

C 

JP 

P, LUP  33 

DEC 

B 

LUP33: 

LD 

(CLUP3) ,BC 

LD 

BC , (TEMP) 

RET 

CLUP1: 

DW 

0 

CLUP2: 

DW 

0 

CLUP3: 

DW 

0 

»•*»*»•»•»»***»**»«»**«*»*»»» 

DATA  STORAGE  AREA 

**»*»»»»»»*«»*»*»**»»»«»*»*** 


DS 

1 0OH 

STACK: 

DS 

8  OH 

TEM  P: 

DW 

0 

REGTOS: 

DW 

RE  GST  K 

DS 

1  0  OH 

RE  GST  K: 

DW 

0 

BCSA  V: 

DW 

1 

DESAV: 

DW 

1 

HLSAV: 

DW 

1 

IXSAV: 

DW 

1 

PTR : 

DS 

20H 

HDR: 

DS 

2  OH 

INHSTK: 

DS 

200H 

NODLST: 

DS 

4  *NUMNOD 

NODES: 

DS 

MAXSTOR 

IYSAV: 

DW 

1 

;  END  OF  BLCK 
END 
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6 

OCT 

83 

14 

DEC 

83  -  REMOVED  STREAM?  AND 

DR  Y? 

21 

DEC 

83  -  MODIFIED  THE  BOOLEAN 

0  PERATORS 

06 

JAN 

84  -  CORRECTED  BXOR 

25 

JAN 

84  -  CORRECTED  BOOLEAN? 

TITLE  BOOL  A/O  25  JAN  84 
GLOBAL  BAND, BOR, BXOR, BNOT 

GLOBAL  ATOM? , NIL? , S YMBOL? , N UMBE R? , BOOLEAN? 

GLOBAL  EM  PT  Y?  ,  SEQUENC  E? 

EXTERNAL  GETATR  ,  ALOS  YN  ,  ATR,  PR  LINE 
EXTERNAL  SA VRE G, RSTRE G 

.  XL  1ST 

MACLIB  EQATMO 
EQUATES 

.  LIST 

{LOGICAL  FUNCTIONS  'AND,OR,XOR»  TAKE  TWO 
;  ATTR  IB  UTES  X,  Y  AND  COMPUTE  RESULT  Z 
{'NOT'  TAKES  1  ATTR.  AND  PRODUCES  ITS  COMPLEMENT 
; PREDICATES  • ATM? , SEQ? , STR? •  TAKE  1  ATTR.  X 
; A  ND  PRODUCE  1  LOGICAL  ATTR  Z 


;F  IRST 

3  LOGICAL  FUNCTIONS 

USE  GT2BOL  TO 

{FETCH 

X,  Y,  GET  INDEX  OF  Z, 

RETURN  A  =X  +Y 

{WHERE 

T=5  4H  ,  F =4  6H 

BAND: 

CALL  GT2B0L 

CP  OA  8H 

JP  NZ , STFA  L 

{  TRUE  + 

TRUE 

JP  STTRU 

BOR  : 

CALL  GT2BOL 

CP  09AH 

JP  M.STFAL 

{  TRUE  + 

FALSE 

JP  STTRU 

BXOR  : 

CALL  GT2BOL 

CP  09AH 

;  TRUE  + 

FALSE 

JP  Z, STTRU 

;  6  JAN 

JP  STFAL 

{  6  JAN 

BNOT: 

CALL  GT  IB  OL 

CP  FALSE 

JP  NZ, STFAL 

;  FALSE? 

t 


FALSE? 


JP  STTRU 


STTRU:  LD  A,  TRUE 

JP  STCOM 

STEAL:  LD  A,  FALSE 

STCOM: 

LD  (BRES).A 
CALL  STBOOL 
RET 

GT  1BOL: 

LD  BC,  1 

LD  (NINH+ATR) ,BC 
LD  (NSYN+ATR) ,BC 
LD  BC.YATR 
LD  (DESC+ATR)  ,BC 
CALL  GETATR 

GT IB.  1 : 

LD  HL,  (  YATR  ) 

LD  DE.YY 
LD  BC,  1 1 
LDIR 

LD  HL, ( ZATR  ) 

LD  DE.ZZ 

LDI 

LDI 

LD  A , (  T  YP  +Y  Y  ) 
CALL  CHKBOL 
LD  IY.CYY+FST) 

LD  A,  (IY) 

RET 


GT2BOL: 

;GE T  2  ATTR.  FROM  STACK,  CHECK  IF  BOOLEAN 
;MA  KE  A  =X  +Y  (T  =  1 ,  F  =0 )  ,  SAVE  INIYX  OF  RESULT 
LD  BC, 2 

LD  (NINH+ATR  )  ,BC 
LD  BC,  1 

LD  (NSYN+ATR ) ,BC 
LD  BC, XATR 
LD  (DESC+ATR ) ,BC 
CALL  GETATR 
LD  HL, ( XATR  ) 

LD  DE, XX 
LD  BC,  1 1 
LDIR 

LD  A , ( T  YP+XX ) 

CALL  CHKBOL 
CALL  GT  IB.  1 
LD  I  X , ( FST  +KX ) 


ADD  A,  (IX) 
RET 


• 

STBOOL: 

MM 

{SAVES 

VALUE  OF  A  AS  LOG.  RESULT 

{ALLOCATES 

A  BOOLEAN  NODE,  STORE 

LD 

A, BOOLN 

LD 

(TYP+ZZ)  ,  A 

LD 

BC,  1 

LD 

(ZZ+SPC)  ,BC 

LD 

DE,( ZATR) 

LD 

HL,  11 

LD 

BC,  5 

LDIR 

CALL  ALOSYN 

EX 

DE.HL 

LD 

BC,  6 

LDIR 

LD 

IX,  (  FST+ZZ) 

LD 

A,( BRES) 

LD 

(IX)  ,  A 

• 

t 

RET 

RESULT 


•  ,,,,,,,, 

ATOM?  : 


CALL  GTTYP 
CP  ATOM 
JP  M.STTRU 
JP  STFAL 


NIL?  : 

CALL  GTTYP 
CP  STREM 
JP  Z , STF AL 
CP  NIL 
JP  Z.STTRU 
CALL  CH  KMT 
JP  Z.STTRU 
JP  STFAL 

SYMBOL?  : 

CALL  GTTYP 
AND  OF  OH 
CP  SYMBL 
JP  Z.STTRU 
JP  STFAL 


NUMBER?  : 

CALL  GTTYP 
AND  OF  OH 


BOOLEAN? 


BOOL1: 


EMPTY?  : 


CP  NUMBR 
JP  Z.STTRU 
JP  STEAL 


CALL  GTTYP 
CP  BOOLN 


JP 

Z , BOOL  1 

;  1/25 

JP 

STFAL 

LD 

HL.6+YY  ; 

1/25  GET  1ST  CHAR  OF  SYMBOL 

LD 

B,  (HL) 

INC 

HL 

LD 

C,  (HL) 

LD 

A,  ( BC) 

C  P 

TRUE 

;  IS  TRUE? 

JP 

Z.STTRU 

;  YES  -  SYMBOL 

IS 

BOOLE 

CP 

FALSE 

;  IS  FALSE? 

JP 

Z.STTRU 

;  YES  -  SYMBOL 

IS 

BOOLE 

JP 

STFAL 

;  NO  -  SYMBOL 

IS 

NOT  B 

CALL  GTTYP 
AND  OF  OH 
CP  SYMBL 
JP  NZ, STFAL 
CALL  CHKMT 
JP  Z.STTRU 
JP  STFAL 


SEQUENCE?  : 

CALL  GTTYP 
CP  SEQNC 
JP  Z.STTRU 
JP  STFAL 


GTTYP: 

CALL  GTTWO 
LD  A , (T  YP  +YY  ) 
RET 


GTTWO: 

LD  BC,  1 

LD  (N INH+ATR ) , BC 
LD  (NSYN+ATR) ,BC 
LD  BC, YATR 
LD  (DESC+ATR) ,BC 
CALL  GETATR 
LD  HL.(YATR) 

LD  DE.YY 


LD  BC, 1 1 
LDIR 

LD  HL, ( ZATR ) 

LD  DE,ZZ 

LDI 

LDI 

RET 


CHKBOL: 

{CHECKS  THAT  A=(TYP)  IS  'BOOLN* 

CP  BOOLN 
RET  Z 

LD  DE , $C  HKB  ;  TYPE  IS  NOT  BOOLEAN 

CALL  PRLINE 

RET 

9 

$C  HKB :  DB  ‘TRYING  LOGICAL  OP  ON  NON-BOOLN  $' 


CHKMT: 


LD  HL , ( S  PC  +Y Y ) 
LD  DE, 0 
OR  0 

SBC  HL, DE 
RET 


»»»»»»» 

•  •  • 

9  9  9 

XATR : 

DW 

0 

YATR : 

DW 

0 

ZATR  : 

DW 

0 

XX: 

DS 

12 

YY: 

DS 

12 

ZZ: 

DS 

1  2 

BRES: 

DB 

END 

0 

{END  OF 

B  00  L •  •  • 

•  •  • 

6  OCT 
15  DEC 
13  JAN 


:  83  -  REMOVED  DEAD  WOOD  STORAGE  AND  MODULES 
I  84  -  REMOVED  TR  FROM  CONVERSION  MODULES 

TITLE  CON V  A/O  13  JAN  84 


GLOBAL  ID.SYMSEQ 
GLOBAL  SE  QS  YM ,  SE  QN  UM ,  N  UMS  YM ,  R  V 
GLOBAL  DL, DR, SEL, SER 
• 

EXTERNAL  ATR,  GETATR  ,  ALOS  YN  ,  PR  LINE  ,  HDR 
EXTERNAL  GETNOD, FETC H, ALLOC , SA VRE G, RSTREG 
EXTERNAL  BCDHEX,  BCDASC,  PSHINH,  POPINH 
EXTERNAL  MA  KN  UM ,  MA  KS  YM ,  IN  PB  UF 
EXTERNAL  SETINH, STKINH, RSTINH 

EXTERNAL  INH.  1 , INH . 2,  INH . 3. INH. 4 

. XL  1ST 

MACLIB  EQATMO 

EQUATES 


MACLIB  MACROS 


.  LIST 


•  i  *  i  i  •  i  i  i  i  i  i  i  >  t  i  i  i  t  i  i  i  *  i  i  i  *  >  i  i  >  i 

Id: 

{MAKES  Z  AN  IDENTICAL  COPY  OF  X 
{UNSTACK  X, Y  AND  DO  FETCH  ON  X 
CALL  GETYZ 

{ALLOCATE  THE  Y  NODE 
ID.  Is 

LD  DE  ,  (  S  PC  +Y  Y  ) 

LD  (S  PC  +Z  Z)  ,  DE 
LD  A , ( T YP  +Y Y ) 

LD  (T  YP  +Z  Z)  ,  A 
CALL  ALOCZ 

{NOW  COPY  DATA  OF  X  -  >  Y 
{UNLESS  X  IS  NIL,  EMPTY  OR  DRY 
CALL  CH  KMT 
RET  Z 

LD  DE , ( FST+Z  Z ) 

LD  H L , ( FST  +YY ) 

LD  BC ,  (  S  PC  +Y  Y  ) 

I 


SYMSEQ: 

{CONVERTS  SYMBOL  X  TO  SEQ  OF  INDIVIDUAL  CHARS  Y 
CALL  GET  YZ 

{CHECK  THAT  X  IS  SYMBL 
CALL  CHKSYM 
JP  NZ.SMSQ.9 
LD  A.SEQNC 
LD  (TYP+ZZ)  ,  A 
{CHECK  IF  X  IS  EMPTY 
CALL  CHKMT 
JP  Z.MAKNIL 

;  X  =S  YM  BL,  SO  ALLOCATE  Y.  S  PC  (  Y  )  =  2  *S  PC  (  X  ) 

{SINCE  EACH  CHAR  REQUIRES  ITS  OWN  NODE 
LD  BC,  (SPC+YY) 

SLA  C 
RL  B 

LD  (SPC+ZZ)  ,BC 

{ALLOC  Y 

CALL  ALOCZ 
LD  DE,(FST+ZZ) 

{SPC=1,  TYP  =S  YMBL  FOR  ALL  NEW  NODES 
LD  BC, 1 

LD  (S  PC  +H  DR  )  ,  BC 
LD  A, S  YMBL 
LD  (T  YP+H  DR  )  ,  A 

{LOOP  TO  MAKE  AND  STORE  NODES  FOR  EACH  CHAR  IN  X 
LD  BC, (SPC+YY) 

CALL  STLUP1 
LD  I  X , ( FST  +YY ) 

SMSQ.  Is  CALL  LUP 1 

JP  M, SMSQ. 2 
{GET  A  NEW  NODE 

CALL  GETNOD 
{STORE  ITS  INDEX  IN  Y 
LD  HL,  IDX+HDR 
LDI 
LDI 

{ALLOC  THE  NEW  NODE  (1-BYTE  LONG) 

{AND  STORE  NEXT  BYTE  FROM  X 
CALL  ALLOC 
LD  I Y , ( FST  +H DR ) 

{GET  NEXT  CHAR  IN  X 
LD  A, (IX ) 

INC  IX 
LD  ( I Y )  ,  A 
JP  SMSQ.  1 
SMSQ.  2:  RET 

SMSQ.  9:  LD  DE  ,  $SMSQ 
JP  QUIT 

ISMSQ:  DB  'TRYING  SYMSEQ  ON  NON-SYMBL  $' 


ruvsn 


;SEQS YM  AND  SEQNUM  USE  A  ROUTINE  SQSYNM 
{WHICH  DOES  MOST  OF  THE  WORK 
SEQS  YM  : 

CALL  GETYZ 

{CHECK  THAT  X  IS  A  SEQNC 
CALL  CHKSEQ 
JP  NZ.SQSM9 
LD  A,  SYMBL 
LD  (T  YP  +Z  Z)  ,  A 
CALL  CHKMT 
JP  Z.MAKNIL 
CALL  SQSYNM 
{PASS  IDX(Y)  TO  MAKSYM 
LD  DE ,  ( I  D  X+Z  Z ) 

LD  ( IDX  +H  DR )  ,  DE 

{CALL  MAKSYM  TO  STORE  CONTENTS  OF  INPBUF  IN  Y 
CALL  MAKSYM 
RET 

t 


SEQNUM  : 

{SQSYNM  FILLS  INPBUF  WITH  ASCII  DIGITS  OF  X 
CALL  GETYZ 

{CHECK  THAT  X  IS  A  SEQNC 
CALL  CHKSEQ 
JP  NZ , SQSM  9 
LD  A.NUMBR 
LD  (ZZ+TYP)  ,A 
CALL  CHKMT 
JP  Z.MAKNIL 
CALL  SQSYNM 

{GIVE  INDEX  OF  Y  TO  MAKNUM,  WHICH  DOES 

{EVERYTHING  ELSE 

LD  DE.CIDX+ZZ) 

LD  (IDX+HDR)  ,  DE 
CALL  MAKNUM 
RET 


SQS  YNM  : 

{CONCATENATES  A  SEQ  OF  SYMBOLS  (X)  INTO 
{ONE  SYMBOL  IN  INPBUF 

{MAKNUM  OR  MAKSYM  CONVERT  THIS  SYMBOL 
{INTO  A  NUMBER  OR  SYMBOL  NODE 
{ADD  UP  ALL  THE  LENGTHS  OF  THE  SYMBOLS  IN  X 
{CONCATENATE  SYMBOLS  INTO  INPBUF 
{ALSO  CHECK  THAT  ALL  ARE  SYMBL’S 
LD  BC  ,  (S  PC  +YY  ) 

LD  IX,  (  FST+YY  ) 


'  V* 


98 


CALL  MAKSYM 
RET 

NMSY.9:  LD  DE ,  $NM  S Y 
JP  QUIT 

$NMSY:  DB  'TRYING  NUMSYM  ON  NON-NUMBER  $' 


R  V: 

;C  OPI ES  SEQ  X  TO  Y,  OBJECTS  IN  REVERSE  ORDER 
CALL  GET  YZ 

;C  HEC  K  THAT  X  IS  SEQNC 
CALL  CHKSEQ 
JP  NZ, RV. 9 
LD  A, SEQNC 
LD  (TYP+ZZ)  ,  A 
CALL  CHKMT 
JP  Z.MAKNIL 

{ALLOCATE  Y,  SAME  SIZE  AS  X 
LD  HL,  (SPC+YY) 

LD  (S  PC  +Z  Z)  ,  HL 
CALL  ALOCZ 

{COPY  INDICES  OF  X  TO  Y,  IN  REVERSE 
LD  BC,  (SPC+YY) 

;BC=#  OF  INDICES 
SRL  B 
RR  C 

CALL  STLUP1 
LD  I  X , ( FST  +YY ) 

LD  I Y , ( LS  T+Z  Z ) 

DEC  IY 

RV.  1:  CALL  LUP  1 

JP  M,R  V.  2 
LD  E , ( I  X ) 

LD  D  ,  (IX  +1  ) 

LD  ( I Y )  ,  E 
LD  (IY+1),D 
INC  IX 
INC  IX 
DEC  IY 
DEC  IY 
JP  RV.  1 

R  V. 2:  RET 

R V. 9:  LD  DE, $R  V 

JP  QUIT 

$R  V;  DB  'TRYING  RV  ON  NON-SEQNC  $' 


DL: 

{DISTRIBUTE  LEFT,  FLAGGED  BY  'L» 


LD  A, 'L ' 

JP  DLR. 0 

DR: 

;  D  ISTR  IB  UT  E  RIGHT,  FLAGGED  BY  *  R  * 
LD  A  ,  'R  » 

DLR.O:  LD  (L.OR.R),A 

jUNSTACK  X, Y, Z 

CALL  GETXYZ 

;CHECK  THAT  X  IS  SEQNC 
LD  A,  (TYP+XX) 

CP  SEQNC 
JP  NZ  ,  DLR  .  91 

;ALLOCATE  Z  SAME  LN  AS  X 
LD  A,  SEQNC 
LD  (T  YP  +Z  Z)  ,  A 
CALL  CHKMT 
JP  Z.MAKNIL 
LD  B C ,  (  S  PC  +X X  ) 

LD  (SPC+ZZ)  ,  BC 
CALL  ALOCZ 

; I X,  DE  PT  TO  X,Z  DATA  SPACE 
LD  I  X,  (  FST+X X  ) 

LD  DE,(FST+ZZ) 

;  S  ET  UP  DO-LOOP  TO  STEP  THRU  X 
LD  BC,  (SPC+XX) 

SRL  B 
RR  C 

CALL  STLUP1 
DLR.  1  :  CALL  LUP  1 
JP  M , DLR . 2 
;  GET  A  NEW  NODE 

CALL  GETNOD 

;STORE  ITS  INDEX  IN  Z  ( DE ) 

LD  HL,  IDX+HDR 

LDI 

LDI 

; S ET  TYP.SPC  FOR  NEW  NODES  IN  Z 
LD  A, SEQNC 
LD  (T  YP  +H  DR  )  ,  A 
LD  BC, 4 

LD  ( S  PC  +H  DR  )  ,  BC 
; A LLOC ATE  THE  NEW  NODE 
CALL  ALLOC 

;  SA  VE  ITS  FST  A  DDR  IN  IY 
LD  I Y ,  (  FST+H  DR  ) 

;  GET  N  XT  OBJECT  OF  X 
CALL  N  XT  OB  J 
;PUT  ITS  INDEX  IN  HL 

LD  HL,  (  I  DX+HDR  ) 

;  STORE  IN  NEW  NODE,  EITHER 
;  <Y  ,  X.  IXDL)  OR  <X.  I,  YXDR  ) 

LD  A  ,  (  L.  OR.  R  ) 

CP  'R  » 


JP  Z.DROP 

{ IT  *S  DL 

DLOP:  LD  BC,(IDX+YY) 

LD  ( I Y )  ,  C 
LD  ( I  Y  +  1  )  ,  B 
LD  ( I Y  +2 ) , L 
LD  (I  Y+3  )  ,  H 
JP  DLR.  1 
;OR,  IT'S  DIR 
DROP:  LD  BC,(IDX+YY) 

LD  ( I Y )  ,  L 
LD  (I  Y  +  1  )  ,  H 
LD  ( I Y  +2 ) , C 
LD  ( I  Y+3  )  i  B 
JP  DLR.  1 
; A LL  DONE 
DLR. 2:  RET 

{ERROR  MSG 

DLR.  91  :  LD  DE  ,  $DLR91 
JP  QUIT 

$DLR91:  DB  'TRYING  DL/R  ON  NON-SEQNC  $' 
L  .  OR  .  R :  DW  0 

•SELECT  LEFT/ RIGHT 


SEL: 

;SEL  FLAGGED  BY  'L  ' 

LD  A, 'L' 

JP  SL. 0 

SER: 

; S ER  FLAGGED  BY  'R  ' 

LD  A, 'R ' 

SL.O:  LD  (L  .  OR  .  R  )  ,  A 

{UNSTACK  X, Y  ;Z 

CALL  GETXYZ 

{CHECK  THAT  X  IS  NON-NIL  SEQNC 
LD  A ,  (  T  YP  +X X  ) 

CP  SEQNC 
JP  NZ , SL. 91 
LD  A, SEQNC 
LD  (TYP+ZZ)  ,  A 
CALL  CHKMT 
JP  Z.MAKNIL 

{CHECK  THAT  Y  IS  A  LEGAL  If 

SL.  1:  LD  A,  (TYP+YY) 

CP  POSFXP 
JP  NZ , SL. 92 

{INTEGER  PART  MUST  BE  <  1 . E6  (ARBITRARY) 
LD  I Y , ( FST  +YY ) 

LD  A, ( IY) 


{CONVERT  Y 


JP  Z.SL.92 
CP  4 

JP  P.SL.92 

(HL)  TO  HEX  IN  ( YHEX ) 
LD  C, ( I Y) 

LD  H  L  ,  ( FST  +YY ) 

INC  HL 
INC  HL 
LD  DE.YHEX 
CALL  BCDHEX 

{COMPARE  Y  TO  0  AND  LN  (X  ) 

LD  BC , 0 
LD  HL, (YHEX) 

OR  0 

SBC  HL, BC 
JP  Z,SL.  92 

;H L  =#  OF  OBJECTS  IN  X 
LD  H  L , (S  PC  +XX ) 

SRL  H 
RR  L 
OR  0 

{SUB  Y  TO  SEE  IF  Y>#  OF  OB  JS 
LD  BC  ,  (YHEX ) 

SBC  HL , BC 
JP  M,SL.  92 

{Y  IS  OK,  SO  IS  X 

; BC  =LN  (X )  ,  LET  DE=2«Y-2 

SL.2:  LD  DE  ,  (  YH E X ) 

SLA  E 
RL  D 
DEC  DE 
DEC  DE 
XOR  A 

{DO  EITHER  SEL  OR  SER 
LD  A,  (L.OR.  R  ) 

CP  *R  » 

JP  Z , SEROP 

SELOP:  LD  HL,(FST+XX) 

ADD  H  L,  DE 
JP  SL.3 


SEROP:  LD  HL, (LST+XX) 

DEC  HL 
XOR  A 
SBC  HL ,  DE 

{HL  NOW  PTS  TO  SELECTED  OBJ  IN  X 
{SET  UP  INHSTK  SO  ID  CAN  JUST  COPY  X. Y->Z 
SL.  3:  LD  DE,  IDX+HDR 

LDI 
LDI 

{PUSH  X. Y  ONTO  INHSTK 
CALL  PSHINH 


;  SET  UP  FOR  CALL  TO  ID  (MODIFIED  11/22) 


CALL  SETINH  ;  11/22 

LD  B C ,  4  ;  11/22 

PUSH  BC  ;  11/22 

CALL  STKINH  ;  11/22 

LD  BC ,  3  J  11/22 

PUSH  BC  ;  11/22 

CALL  STKINH  ;  11/22 

CALL  ID  ;  11/22 

CALL  RSTINH  ;  11/22 

CALL  POPINH 
; A LL  DONE 

RET 


SL.  91  :  LD  DE  ,  $SLR  91 
JP  QUIT 

SL.92:  LD  D£,$SLR92 

JP  QUIT 

$S  LR  91  :  DB  'TRYING  SEL/R  ON  NIL  OR  NON-SEQNC  $' 

$SLR  92:  DB  'FOR  X.  K:  K>  !  X  i  ,  K>1.E6,  OR  K  =  <  0  $' 
• 

YHEX:  DW  0 


99999999999999999999999999999999 

QUIT:  CALL  PR  LINE 

RET 

GET  X  YZ : 

{GETS  3  INDICES  OFF  OF  INHSTK 

;FETCHES  FIRST  2  SO  ALL  THEIR  PROPERTIES  ARE  KNOWN 
LD  BC, 2 

LD  (NINH+ATR  )  ,  BC 
LD  BC, 1 

LD  (NSYN+ATR  )  ,BC 
LD  BC.XATR 
CALL  GTYZ  .  1 
LD  D E , XX 
LD  HL , ( XATR  ) 

LD  BC, 1 1 

LDIR 

RET 

GETYZ  : 

{GETS  2  INDICES  OFF  OF  INHSTK 

{FETCHES  FIRST  ONE  SO  ALL  ITS  PROPERTIES  ARE  KNOWN 
LD  BC, 1 

LD  (NINH+ATR ) ,BC 
LD  (NSYN+ATR)  ,BC 
LD  BC.YATR 

GTYZ.  1: 

LD  (DESC+ATR  )  ,  BC 


CALL  GETATR 


LD  HLf ( YATR  ) 
LD  DE, YY 
LD  BC,  11 
LDIR 

LD  HL, ( ZATR  ) 

LD  DE,  Z  Z 

LDI 

LDI 

RET 


ALOCZ  : 

{ALLOCATES  A  NODE,  USING  PARAMETERS  IN  11 
CALL  SAVREG 
LD  HL, IDX+ZZ 
LD  DE.IDX+HDR 
LD  BC, 5 
LDIR 

CALL  ALLOC 

« 

EX  DE,  HL 
LD  BC,  6 
LDIR 

CALL  RSTREG 
RET 


MAKNIL: 

{MAKES  A  NODE  OF  ZERO  LENGTH,  (TYP+ZZ) 
LD  BC , 0 

LD  (SPC+ZZ)  ,  BC 
CALL  ALOCZ 
RET 


N  XT  OB  J : 

{FETCHES  OBJECT  WITH  INDEX  POINTED  TO  BY  IX 
{STORES  H DR  BLCK  IN  XN  XT 
CALL  SAVREG 
LD  E  ,  ( I X ) 

LD  D,  (  I  X  +  1  ) 

LD  ( IDX  +H  DR ) , DE 
CALL  FETCH 
LD  HL.IDX+HDR 
LD  DE , XN  XT 
LD  BC,  1  1 


CALL  RSTREG 
INC  IX 
INC  IX 
RET 


STLUP  1 : 

LD  ( CLUP 1 ) , BC 
RET 

LUP  Is 

LD  ( BCTEM  P ) , BC 
LD  BC  ,  ( CLUP 1 ) 
DEC  C 
JP  P, DL.  1 
DEC  B 

DL. 1:  LD  ( CLUP 1 ) ,BC 

LD  BC  ,(  BCTEMP ) 
RET 

CLUP  1 :  DW  0 

STLUP2: 

LD  (CLUP2)  ,BC 
RET 

LUP  2: 

LD  (BCTEMP), BC 
LD  BC  ,(CLUP2) 
DEC  C 
JP  P, DL. 2 
DEC  B 

DL. 2:  LD  ( CLUP2) ,BC 

LD  BC, (BCTEMP) 
RET 

CLUP  2:  DW  0 


CHKS  YM  : 

LD  A , (  T  YP  +Y  Y  ) 

CP  SYMBL 
RET 

CHKNUM  : 

LD  A,(TYP+YY) 

AND  OF  OH 
CP  NUMBR 
RET 

CH  KSEQ: 

LD  A,(TYP+YY) 

CP  SEQNC 
RET 

CH  KMT: 

{RETURNS  Z  IF  (SPC+YY)  =  0 
CALL  SAVREG 


a 


t 


& 


6  OCT  83  -  REMOVED  SYNTAX  ERRORS 
27  OCT  83  -  CHANGED  SYMIMM  A  NUMIMM 
14  NOV  83  -  CHANGED  SELIMM 

21  DEC  83  -  REMOVED  DEADWOOD  MODULES  AND  STORAGE  AREAS 


TITLE  IMED  A/O  21  DEC  83 


GLOBAL  NUMIMM,  SYMIMM,  SELIMM,  LENIMM 
GLOBAL  MERIMM 
GLOBAL  CONIMM 

EXTERNAL  ALLOC  ,  FETC  H,  GE  TNOD,  SA  VR  EG,  RSTREG 
EXTERNAL  MA  KN  UM ,  MA  KS  YM ,  PR  LI  N  E,  HE  XBCD 
EXTERNAL  PSHINH  ,  PO  PI  NH  ,  PTR  ,  HDR  ,  INPBUF 
EXTERNAL  RSTBAS 


.  XL  1ST 


MACLIB  EQATMO 
EQUATES 


.  LIST 


I  I  )  I  I  I  I  I  f  I  M  •  I  I  I  ■  I  I  I  I  I  )  I  I  I  I  t  I  I  > 
f 


NUMIMM: 

;C OPY  ASCII  DIGITS  TO  INPBUF 
;  GET  it  OF  CHARS  IN  NUMBER 


POP 

POP 

LD 

POP 

LD 

PUSH 

XOR 

ADD 

JP 


DE 

BC 

( BCTEM  P ) ,BC 
HL 

(HLTEMP)  ,HL 

DE 

A 

A,  C 

Z,  NI. 92 


SAVE  RETURN  ADDRESS 
GET  it  OF  CHARS 


RESTORE  RETURN  ADDRESS 
CHECK  FOR  ZERO  SYMBOLS 


NO  DIGITS  ENTERED 


GET  ADDR  OF  FIRST  CHAR 


NI.  1:  DEC 

c 

JP 

M, NI. 2 

LD 

A,  (HL) 

■vf. 

INC 

HL 

CP 

*+  » 

vi 

JP 

Z, NI.  1 

CP 

»_  t 

V 

JP 

Z , NI.  1 

CP 

i  i 

• 

k  «r 
// 

JP 

Z , NI.  1 

CP 

t  i 

.  ■ 

JP 

Z, NI.  1 

CP 

03AH 

•V 

JP 

P, NI. 9 

»v 

CP 

3  OH 

ALL  CHARACTERS  PROCESSED 


JP  MI.  1 

N  1 .  2:  LD  I  X,  IN  PB  UF  -  1 

LD  BC , ( BCTEM  P ) 

LD  (IX), C 
LD  DE, IN  PB  UF 
LD  H  L , (HLTEMP ) 

LDIR 


;  GET  A  NODE  INDEX 

CALL  GETNOD 

;  PUT  THE  INDEX  ON  THE  STACK 


• 

CALL  PSHINH 

CALL  MAKNUM 

RET 

NI.  9: 

LD  DE  ,  $N  I  91 

NI.  92: 

CALL  PR  LI NE 

RET 

LD  DE, $NI 92 

$N  1 91  : 

CALL  PR  LINE 

RET 

DB  'ILLEGAL  CHAR.  IN  IMMED  NUM 

$NI 92: 

DB  'NIL  INPUT  ON  IMMED  NUM  $' 

HLTEMP: 

DW  0 

BCTEM  P: 

DW  0 

•  ffffffftfffft 

• 

999999999999999999 

t 

SYMIMM: 

;C  OPY  ASCII  CHARS  TO  INPBUF 

;  GET  #  OF  CHARS  IN  SYMBOL 

POP 

DE 

SAVE  RETURN  ADDRESS 

POP 

BC 

#  OF  SYMBOLS 

POP 

HL 

A  DDR  OF  FIRST  SYMBOL 

PUSH 

DE 

RESTORE  RETURN  ADDRESS 

XOR 

A 

CLEAR  ACCUMULATOR 

SBC 

A,  B 

CHECK  FOR  >  255  SYMBOLS 

JP 

M, SI. 9 

XOR 

A 

CHECK  FOR  0  SYMBOLS 

ADD 

A,  C 

JP 

Z, SI. 9 

;  COPY  SYMBOLS 

INTO  BUFFE" 

LD  IX, 

IN  PB  UF  — 1 

LD  (IX),C 
; S ET  DE  TO  INPBUF 

LD  DE, INPBUF 
;CO P Y  CHARS 
LDIR 

;  GET  A  NODE  INDEX 

CALL  GETNOD 

;  PUT  THE  INDEX  ON  THE  STACK 
CALL  PSHINH 


;CALL  MAKSYM  TO  ALLOC  NODE  AND  STORE  CHARS 


CALL  MAKSYM 

RET 

SI.  9: 

LD  DE  ,  $SI9 

CALL  PR  L I  NE 

RET 

;  11/14 

$SI  9: 

DB  '0  OR  >255  CHARS  IN 

IMMED  SYM 

SELIMM  : 


{GETS  SEQNC 

X  FROM  TOP 

OF 

INHSTK,  AND 

{REPLACES  IT 

WITH  X.I 

CALL 

SAVREG 

POP 

DE 

{  11/14 

POP 

BC 

{  11/14 

PUSH 

DE 

;  11/14 

{FETCH  TOP-MOST  INDEX, 

PUT 

IN  (IDX+HDR) 

CALL  FETTOP 
{FETCH  FST  A  DDR  OF  X 
CALL  FETCH 

{CHECK  THAT  X  IS  SEQNC  AND  !X!=>I 
LD  A ,  (  T  YP  +H  DR  ) 

CP  SEQNC 
JP  NZ  ,  IS.  10 
LD  HL,  (SPC+HDR  ) 

SLA  C 

RL  B 

AND  0 

SBC  HL.BC 

JP  M, IS. 1 0 

LD  IY,  (  FST+HDR  ) 

;BC  =  2*1,  SET  BY  SEL  MACRO 
DEC  BC 
DEC  BC 

{POINT  IY  TO  I'TH  ENTRY  IN  X 
ADD  I Y, BC 
LD  L, ( I Y ) 

LD  H,  (IY+1  ) 

LD  (IDXIMM)  ,  HL 

;  POP  X 

CALL  POPINH 
{PUSH  X. I 

LD  HL, (IDXIMM) 

LD  (IDX+HDR) ,HL 
CALL  PSHINH 
CALL  RSTREG 
RET 

{ERROR  MESSAGE 
IS.  10:  LD  DE, $S  EL 
CALL  PR  LI NE 

CALL  RSTREG  { 

RET  { 


SAVE  RETURN  A  DDR 
GET  ITH  INDEX  IN 
RESTORE  RETURN  A 


11/14 

11/14 


$SE  L:  DB  'TRYING  SEL  ON  NON-SEQNC,  OR  TOO  SHORT  $' 


LENIMM  : 

{GETS  SEQNC  X  FROM  TOP  OF  INHSTK,  AND 

{FINDS  ITS  LENGTH.  LEAVES  NUMERIC  ATOM  ON  INHSTK. 

CALL  SAVREG 

{FETCH  TOP-MOST  INDEX,  PUT  IN  (IDX+HDR) 

CALL  FETTOP 
CALL  FETCH 

{CHECK  THAT  X  IS  SEQNC 
LD  A,  (TYP+HDR  ) 

CP  SEQNC 
JP  NZ  ,  IL.  10 

{CALL  HXBC  TO  CONVERT  (SPC+HDR)/2  TO  PACKED  BCD  DIGITS 
LD  HL,  (SPC+HDR  ) 

SRL  H 
RR  L 

LD  DE,  ILBUF +2 
CALL  HEXBCD 

{FIND  #  OF  NON-ZERO  BYTES 
LD  HL.ILBUF+2 
LD  BC, 2 

IL.  0:  LD  A,  (HL) 

CP  0 

JP  NZ , IL.  1 
INC  HL 
DEC  C 

JP  NZ.IL.O 

{SHIFT  NON-ZERO  DIGITS  UP  IN  I  LB  UF 
IL. Is  INC  BC 
LDIR 

EX  DE, HL 
LD  DE,  I  LB  UF  +  2 
OR  A 

SBC  HL,  DF. 

EX  DE,  HL 
LD  HL,  ILBUF 

{STORE  0  OF  DIGITS  IN  ILBUF 
LD  (H  L  )  ,  E 
INC  DE 
INC  DE 

{DEFINE  NODE  SPACE  NEEDED 
LD  (S  PC  +H  DR  )  ,  DE 
{ALLOCATE  NODE  OF  TYPE  POSFXP 
LD  A,  POSFXP 
LD  (TYP+HDR), A 
{GET  A  NEW  NODE 

CALL  GETNOD 
LD  HL, (IDX+HDR) 

LD  (IDXIMM)  ,  HL 
CALL  ALLOC 


{TRANSFER  I  LB UF  TO  NODE 
LD  DE , ( FST+H  DR  ) 

LD  BC  ,  (S  PC  +H  DR  ) 

LD  HL,  ILBUF 
LDIR 

{ALL  DONE 
{POP  X 

CALL  POPINH 
{PUSH  ! X ! 

LD  HL,  ( ID XI MM) 

LD  (IDX+HDR)  ,HL 
CALL  PSHINH 
CALL  RSTREG 
RET 

{ERROR  MESSAGE 
IL. 10:  LD  DE, $LEN 

CALL  PRLINE 
CALL  RSTREG 

RET 

$LE N:  DB  'TRYING  LEN  FN  ON  NON-SEQNC  $' 

ILBUF:  DS  5 


9999999999999999999999999999999 

• 

CONIMM: 

{UNSTACKS  INDICES  FROM  INHSTK  AND  MAKES  A  SEQNC 

{LEAVING  SEQNC  INDEX  ON  INHSTK 

• 

9 

CALL  SAVREG 
{COUNT  #  OF  INDICES 
CALL  CNTSTK 
{GET  A  NEW  INDEX 

CALL  GETNOD 
LD  DE, (IDX+HDR) 

LD  (IDXIMM)  ,  DE 
{SET  NODE  TYPE  TO  SEQNC 
LD  A,  SEQNC 
LD  (T  YP  +H  DR  )  ,  A 
{DEFINE  SPACE  NEEDED 

LD  H  L , ( C  NT IM  M ) 

SLA  L 
RL  H 

LD  (S  PC  +H  DR  )  ,  HL 
{ALLOCATE  THE  NODE 
CALL  ALLOC 
LD  BC, 0 
OR  0 

SBC  HL , BC 
JP  Z  ,  CO  N.  1 
LD  BC,  (SPC+HDR  ) 

{TRANSFER  THE  STACKED  INDICES  TO  THE  NODE 
LD  HL, ( BAS+PTR ) 


INC  HL 
INC  HL 

LD  DE  ,  (  FST+H  DR  ) 
LDIR 

;SET  TOP  BACK  TO  BAS  PTR 
CON.  Is 

CALL  RSTBAS 
;  P (JSH  NEW  NODE  INDEX  ONTO 
LD  DE  ,  ( I DXIMM) 

LD  ( IDX  +HDR ) , DE 
CALL  PSHINH 
CALL  RSTREG 
RET 


INHSTK 


NON-MATCH  FOUND 


IERIMM: 

;GE TS  SEQNC  '  S  X,  ,  ,  Y  FROM  TOP  OF  INHS 
;  RE  PLACES  THEM  WITH  ONE  SEQNC  Z  WITH 
[ELEMENTS.  LEAVES  Z  ON  INHSTK. 

CALL  SAVREG 

[SET  CNTIMM  =  #  OF  NODES  ON  STK 
CALL  CNTSTK 

[CHECK  THAT  ALL  X,  ,  ,  Y  ARE  SEQNC 'S 
LD  A, SEQNC 
LD  (TYPIMM) , A 
CALL  CHKSTK 

[IF  A  RETURNS  .  NE .  0,  NON-MATCH  FOUN 
CP  0 

JP  NZ , MI. 10 

SET  LENSUM  =  TOTAL  LENGTH  OF  ALL  X, 
CALL  TOTSTK 

[SPECIFY  NODE  TYP  AND  S  PC ,  ALLOCATE 
LD  A, (TYPIMM) 

LD  (T  YP  +H  DR  )  ,  A 
LD  BC, (LENSUM) 

LD  (S  PC  +H  DR  )  ,  BC 
[GET  NEW  NODE  INDEX,  ALLOCATE 
CALL  GETNOD 
LD  HL,  (IDX+HDR  ) 

LD  (I DXIMM) , HL 
CALL  ALLOC 

[SET  DE  =  F  ST  A  DDR  OF  NODE,  COPY  ALL 
LD  D E , ( FST  +H DR ) 

LD  BC, ( CNTIMM) 

[IX  PTS  TO  BOTTOM  OF  CONS  STACK 
LD  IX, ( BAS+PTR ) 

INC  IX 
INC  IX 

II.  Is 

DEC  C 
JP  P,  MI.  2 
DEC  B 


INHSTK 
WITH  ALL 


THEIR 


X,  ,  ,  Y 


CNTIMM  NODES 


ST'TTTTTF 


1  1  2 


JP  M , M 1 .  3 
MI. 2:  PUSH  BC 

;US  E  BC,  HL  TO  GET  ELEMENT  COUNTS,  NODE  INDICES 
LD  L , ( I X ) 

LD  H  ,  (  I  X  +  1  ) 

INC  IX 
INC  IX 

LD  ( I DX+H  DR ) , HL 
;FETCH  NEXT  NODE 

CALL  FETCH 
LD  BC,  (SPC+HDR  ) 

LD  HL,  (  FST+HDR  ) 

;CO PY  (SPC+HDR)  BYTES  FROM  NODE 
LDIR 

{RESTORE  BC  =NODE  COUNT 
POP  BC 

{REPEAT  LOOP 

JP  M  I.  1 

{RESET  TOP  =CONS  +  PTR 

MI.  3: 

CALL  RSTBAS 

{PUT  NEW  NODE  ON  INHSTK 
LD  HL,  (  I  DXIMM) 

LD  (IDX+HDR) ,HL 
CALL  PSHINH 
CALL  RSTREG 
RET 

{ERROR  MSG 
MI.  10:  LD  DE,  $MER 

CALL  PR  LI N E 
CALL  RSTREG 
RET 

$MER:  DB  'TRYING  MERGE  OF  NON-SEQNC  $' 


99999999999999999999999999999999 

FETTOP: 

{FETCHES  TOP-MOST  INDEX,  PUTS  IT  INTO  (IDX+HDR) 
PUSH  IX 
PUSH  DE 

LD  IX, ( TOP+PTR ) 

DEC  IX 
DEC  IX 
LD  E , ( I X ) 

LD  D,  (  I  X  +  1  ) 

LD  (IDX+HDR), DE 
POP  DE 
POP  IX 
RET 


9999999999999999999999999999999 


CNTSTK 


;COUNTS  it  OF  NODES  ON  INHSTK,  FROM  CONS  TO  TOP 
CALL  SAVREG 
LD  H  L , (TOP  +PTR  ) 

LD  DE , ( BAS+PT  R  ) 

OR  0 

SBC  HL ,  DE 
LD  DE,  2 
SBC  HL ,  DE 
SR  L  H 
RR  L 

LD  ( CNTIMM) , HL 
CALL  RSTREG 
RET 


TOTSTK: 

;  A  DDS  UP  it  OF  ALL  BYTES  STORED  IN  NODES 

; F R OM  CONS  TO  TOP,  STORES  SUM  IN  (LENSUM) 
CALL  SAVREG 

; BC  =  it  OF  NODES  ON  CONS  ST  K 
LD  BC, (CNTIMM) 

; IX  =  PTR  TO  NODES  ON  STK 
LD  IX, ( BAS+PTR ) 

INC  IX 
INC  IX 

;  H  L  =  SUM  OF  BYTES  IN  NODES 
LD  HL,  0 

TS. 1 :  DEC  C 

JP  P.TS.2 
DEC  B 
JP  M , TS. 3 

TS.  2:  LD  E  ,  (IX) 

LD  D,  (  IX  +  1  ) 

INC  IX 
INC  IX 

LD  ( I  DX+H  DR  )  ,  DE 

;FETCH  EACH  NODE  TO  GET  ITS  LENGTH 
CALL  FETCH 
LD  DE,  (SPC-t-HDR  ) 

ADD  HL,  DE 
JP  TS. 1 

TS. 3:  LD  (LENSUM) , HL 

CALL  RSTREG 
RET 


CHKSTK: 

; C  HEC  KS  ALL  NODES  ON  CONS  STK  TO  SEE  IF  THEY 
; A R E  SAME  AS  (TYPIMM) 

CALL  SAVREG 

;BC  =  it  OF  NODES  ON  CONS  STK 


LD  BC.(CNTIMM) 

; I X  =  PTR  TO  NODES  ON  ST K 
LD  I  X , ( BAS  +  PTR ) 

INC  IX 
INC  IX 

CS. 1 :  DEC  C 

JP  P.CS.2 
DEC  B 
JP  M , CS . 3 
CS. 2:  LD  E , ( I X  ) 

LD  D,  (  I  X  +  1  ) 

INC  IX 
INC  IX 

LD  ( I DX+H  DR ) , DE 

;FETCH  EACH  NODE  TO  GET  ITS  TYPE 
CALL  FETCH 
LD  A , (T  YP  +HDR  ) 

LD  E,  A 

LD  A, (TYPIMM) 

SUB  E 

; I F  ANY  DON'T  MATCH,  RET  WITH  A  .NE.  0 
JP  NZ.CS.3 
JP  CS.  1 

CS. 3:  CALL  RSTREG 

RET 

LUP 1 :  LD  BC , ( STLUP  1  ) 

DEC  C 

JP  P.LUP11 
DEC  B 

LUPIIs  LD  (STLUP 1 )  ,8C 
RET 

STLUP  1 :  DW  0 

CNTIMM:  DW  0  ;NODES  ON  ST K 

LENSUM:  DW  0  ;SUM  OF  THEIR  LENGTHS 

IDXIMM:  DW  0  ; I DX  OF  IMM  NODE 

TYPIMM:  DB  0  ;ITS  TYP 

EN 


;  6  OCT  83 

;  21  DEC  83  -  REMOVED  DEAD  WOOD  MODULES  AND  STORAGE  AREAS 

• 

TITLE  IONS  A/O  21  DEC  83 

GLOBAL  PRNUM  ,  PRSYM  ,  PRBUL 
GLOBAL  MAKNUM, OUTNUM 
GLOBAL  MAKS  YM  ,  OUTSYM 
GLOBAL  OUTBUL 
GLOBAL  INPBUF 

EXTERNAL  GETATR , HDR , ALLOC , ATR 
EXTERNAL  PRCON 
EXTERNAL  ASC  BC  D,  BC  DA  SC 
EXTERNAL  SA VRE G, RST RE G 

. XL  1ST 

MACLIB  EQATMO 
EQUATES 

.  LIST 

9 


MAKNUM  : 

; C  ON  VE  RTS  ASCII  CHARACTERS  IN  INPBUF  TO  FXP  NODE 
CALL  SAVREG 
LD  DE , ( I DX+H  DR ) 

LD  (  ZZ+IDX)  ,  DE 

MN.  1  : 

;DEF  A  ULT  SIGN  IS 

LD  A , POSFXP 
LD  (SIGN), A 

; SET  FLAGS  AND  DIG  COUNTS  TO  0 
LD  BC , 0 
LD  (DECPT).BC 
LD  (DECCNT) , BC 

;GET  C NT  OF  CHAR  READ 
LD  HL,  CHCNT 
LD  C , ( H  L  ) 

; SET  DE  TO  BUFFER  FOR  DIGITS 
LD  DE.DIGBUF 

;THIS  THE  LOOP  WHICH  EXAMINES  ALL  CHARS 

IN.  1  : 

;DEC  CHAR  COUNT  UNTIL  END  OF  BUFFER  REACHED 
DEC  C 
JP  M ,  IN . 4 

{GET  NEXT  CHAR 
INC  HL 
LD  A  ,  ( HL  ) 

{IF  SPACE  OR  ,  SKI P 
CP  *  ' 

JP  Z ,  IN.  1 


1  1  6 


JP  Z,  IN.  1 

; I F  CHANGE  SIGN 

CP  ' 

JP  Z , IN. 2 

;  IF  SET  DEC  PT  FLAG  AND  DECCNT 

CP  *  . ' 

JP  Z ,  IN. 3 

{CHECK  IF  BETWEEN  0-9 
CALL  CHKRNG 
JP  NZ, IN. 1  1 

; I F  DIGIT,  STORE  IN  DIGBUF 
INC  B 
LD  ( DE  )  ,  A 
INC  DE 
;  GET  NEXT  CHAR 
JP  IN.  1 

•SETS  SIGN 
IN.  2:  LD  A,  NEGFXP 

LD  (SIGN), A 
JP  IN.  1 

; SETS  DEC  PT  FLAG  AND  DECCNT 
IN.  3: 

;F  IRST  CHECK  IF  FOUND  ALREADY 

LD  A , ( DEC  PT  ) 

CP  0 

JP  NZ ,  IN.  1  1 
; E LSE  SET  ( D I GC NT  )  =B 
LD  A,  B 

LD  ( D IGC  NT  )  ,  A 
LD  B,  0 
LD  A,  1 

LD  ( DE C  PT  )  ,  A 
JP  IN.  1 

;  L  A  ST  CHAR  FOUND,  SO  COMPUTE  //  OF  DIGITS 
; TO  RIGHT  OF  DEC  PT 
; F  IRST  SEE  IF  •  READ 
5  IF  NOT,  SKIP  PAST  DECCNT  COMPUTATION 
IN. 4:  LD  A, ( DEC  PT  ) 

CP  0 

JP  Z ,  IN. 7 

WAS  READ,  SO  GET  if  OF  TRAILING  DIGITS 
; IF  DECCNT  ODD,  STORE  TRAILING  'O’ 

IN. 5:  BIT  0, B 

JP  Z,  IN.  6 
INC  B 
LD  A,  '0  ' 

LD  ( DE  )  ,  A 
,-SAVE  IN  (DECCNT) 

IN. 6:  LD  A, B 

{DIVIDE  DEC  COUNT  BY  2 
SRL  A 

LD  (DECCNT), A 


IN.  7 


LD  A,(DIGCNT) 
LD  B,  A 


LD  DE.DIGBUF 
BIT  0 , B 
JP  Z ,  IN. 8 
INC  B 
DEC  DE 
IN.  8:  LD  A ,  B 

{DIVIDE  LEAD  COUNT  BY  2 
SR  L  A 

LD  ( D IGC  NT  )  ,  A 

;SAFE  TO  USE  SAME  BUFFER  FOR  ASC->HEX  CONVERSION 
IN. 9:  LD  HL,INPBUF 

LD  BC.(DIGCNT) 

ADD  A , B 
LD  C,  A 
LD  B,  0 

{CONVERT  CHARS  TO  PACKED  BCD 
CALL  ASCBCD 
{SET  NODE  TYPE 

LD  A , ( S IGN  ) 

LD  (T  YP  +Z  Z)  ,  A 
{ADD  2  FOR  DIG  COUNTS 
INC  C 
INC  C 

LD  (SPC+ZZ)  , BC 
{ALLOCATE  THE  NODE 
CALL  ALOCZ 

{GET  THE  FIRST  DATA  ADDR 
LD  HL , ( FST+Z  Z ) 

{STORE  DIG  COUNTS 

LD  BC.(DIGCNT) 

LD  ( HL ) , C 
INC  HL 
LD  ( HL )  ,  B 
INC  HL 
LD  A,  C 
ADD  A ,  B 
LD  C,  A 
LD  B,  0 

{ DE  POINTS  TO  DESTINATION,  HL  TO  DIGBUF 
EX  DE,  HL 
LD  HL,  INPBUF 

{BLOCK  MOVE  TO  STORE  NUMBER 
LDIR 

CALL  RSTREG 
RET 

{ERROR  MSG 
IN.  1 1 :  LD  DE , $NM  .  2 
CALL  PRC  ON 


CALL  RSTREG 
RET 


RETURN  TO  FORTH 


PRNUM  : 

OUT  NUN! :  {FETCHES  A  FIXED  POINT  NUMBER  FROM  STORAGE 

{AND  PRINTS  IT  AT  CONSOLE. 

CALL  SAVREG 

{GET  THE  INHER.  NODE  ADDR 
CALL  GET10 
LD  IX,  ZZ 

{CHECK  IF  FIXED  PT  NUMBER 
LD  A,(IX+TYP) 

AND  OF  OH 
CP  NUMBR 
JP  NZ , ON.  10 

{IF  OK,  GET  DEC  AND  DIG  COUNTS 

ON.  1: 

{STORE  SIGN  IN  PRINT  BUFFER 
LD  DE.INPBUF 

{SET  SIGN 

LD  A , ( I X+T YP ) 

LD  B  ,  '  +  ' 

CP  POSFXP 
JP  Z , 0 N . 6 
LD  B , ' -  ' 

ON. 6:  LD  A  ,  B 

LD  (DE  )  ,  A 

{GET  WHL.FRC  COUNTS 

LD  HL, ( ZZ+FST) 

LD  A , ( HL  ) 

LD  B ,  A 

LD  ( D IGC  NT  )  ,  A 
INC  HL 
LD  A , ( H L  ) 

LD  ( DECCNT) , A 
ADD  A ,  B 
LD  C,  A 
LD  B,  0 

{CONVERT  TO  ASCII  CHARS. 

LD  DE , DIGB  UF 
INC  HL 
CALL  BC  DA  SC 

{SET  HL  TO  CONVERTED  DIGITS 
EX  DE  ,  HL 
LD  DE,  IN  PB  UF  +  1 

{FIGURE  OUT  DECIMAL  PLACE 
LD  A , ( D I GC NT  ) 

LD  C,  A 
LD  B,  0 

{IF  NO  LEADING  DIGITS,  SKIP  AHEAD 


JP  Z.0N.2 

;ELSE,  PRINT  DIGITS 
SLA  C 

{SKIP  LEADING  ZERO 
LD  A  ,  ( HL ) 

CP  'O’ 

JP  NZ.ON.3 
INC  HL 
DEC  C 

ON.  3: 

LD  IR 

ON.  2: 

{IF  NO  DIGITST  OT  RIGHT  OF  DEC  PT ,  QUIT 
LD  A , ( DECC  NT ) 

CP  0 

JP  Z , ON. 5 

{ELSE  PRINT  DEC  PT  AND  CONTINUE 
LD  C,  A 
LD  A,'  .  ' 

LD  ( DE  )  ,  A 
INC  DE 
SLA  C 
LDIR 

{CLEAN  OFF  ANY  TRAILING  DIGITS 
ON. 9:  DEC  DE 

LD  A , ( DE  ) 

CP  'O' 

JP  Z , ON. 9 
INC  DE 

{FINISH  BY  PRINTING  DIGBUF 
ON.  5:  LD  HL,  CR  LF  $ 

LD  I 
LD  I 
LD  I 

LD  DE,  INPBUF 
CALL  PRC  0  N 

ON.  1  1  : 

CALL  RSTREG 
RET 

ON . 10:  LD  DE , $NM . 4 
CALL  PRC  ON 
JP  ON.  1  1 


ODH  ,  OAH,  '  $  ' 


C  R  LF  $:  DB 
$ NM .  2: 

DB  'ILLEGAL  CHARACTER  FOUND  IN  FIXED  PT  NUMBER  $ 

$NM . 4: 

DB  'CANNOT  PRINT  NUMBER  ;  NOT  OF  TYPE  FIXED  PT  $' 

$NM . 9: 

DB  'NODE  FOUND  TO  BE  "NIL"  $' 


MAKS  YM  : 

{STORES  CHARS  IN  INPBUF  IN  A  NODE 
CALL  SAVREG 
LD  DE , ( I DX+H  DR ) 

LD  ( ZZ+IDX) , DE 

MS.  1 : 

;GET  C NT  OF  CHAR  READ 
LD  B,  0 

LD  HL,  INPBUF-1 
LD  C  ,  ( HL ) 

;JMP  AROUND  CODE  WHICH  CHOPS  LE  A  DI NG  /  TR  A  IL I NG  BLANKS 
JP  IS. 99 

; SET  DE  TO  SAME  BUFFER 
LD  DE, INPBUF 

{SKIP  OVER  LEADING  BLANKS 

IS.  1 : 

;DEC  CHAR  COUNT  UNTIL  END  OF  BUFFER  REACHED 
DEC  C 
JP  M ,  IS. 2 

{GET  NEXT  CHAR 
INC  HL 
LD  A , ( HL ) 

{IF  SPACE  SKIP 
CP  '  ' 

JP  Z, IS. 1 

{STORE  THE  REST 
LDIR 

{NOW  BACK  UP  OVER  TRAILING  BLANKS 

IS. 2:  DEC  HL 

LD  A, (HL) 

CP  '  » 

JP  Z ,  IS. 2 

{LAST  CHAR  FOUND,  COMPUTE  ACTUAL  LENGTH 
LD  DE, INPBUF-1 
AND  0 
SBC  HL , DE 
LD  C,  L 
LD  B,  H 

IS.  99: 

LD  (S  PC+ZZ)  ,  BC 

{DEFINE  TYP 

LD  A.SYMBL 
LD  (T  YP  +Z  Z)  ,  A 

{ ( I DX+Z  Z )  MUST  BE  DEFINED,  ALLOC  THE  NODE 
CALL  ALOCZ 

{STORE  THE  CHARACTERS 
LD  DE , ( FST+Z  Z ) 

LD  HL,  INPBUF 
LD  BC , (S  PC  +Z  Z) 

LDIR 

{ALL  DONE 

CALL  RSTREG 


PRSYM  : 

OUTS  YM : 

; P R I N T S  A  SYMBOLIC  ATOM  AT  CONSOLE 
CALL  SAVREG 

;GE T  THE  INHER.  NODE  INDEX 
CALL  GET  1 0 
LD  IX, ZZ 

;CHECK  IF  SYMBL 

CALL  CHKSYM 
JP  NZ, OS.  10 

;I 7  OK,  COPY  NODE  TO  INP3UF 
LD  DE.INPBUF 
LD  HL, ( FST+ZZ) 

LD  B  C  ,  ( S  PC  +Z  Z  ) 

LD  I R 

; A  DD  $  TO  END  OF  STRING,  PRINT 
LD  HL, $DLR 
LD  I 

LD  DE,  INPBUF 
LD  C,  9 
CALL  5 
CALL  RSTREG 
RET 

OS.  10:  LD  DE  ,  $S  Y.  4 

CALL  PRC  ON 
CALL  RSTREG 
RET 


CHKSYM  : 

; C  HEC  KS  IF  CURRENT  NODE  (IDX  +  ZZ)  IS  SYMBOLIC  ATOM 
{RETURNS  "  Z"  IF  SYMBL,  "  NZ”  IF  NOT 
LD  A , ( T  YP  +Z  Z ) 

AND  OF  OH 
CP  SYMBL 
RET 

$S  Y. 4 :  DB  'CANNOT  PRINT:  NOT  OF  TYPE  SYMBL  $’ 


PRBUL: 

OUTBUL: 

{PRINTS  VALUE  OF  A  BOOLN  NODE  AT  CONSOLE 
CALL  SAVREG 

{GET  THE  INHER.  NODE  INDEX 
CALL  GET  1  0 


{CHECK  IF  BOOLN 

CALL  CHKBUL 
JP  NZ.OB.5 

{READ  VALUE  OF  NODE 

LD  I  X , ( FST+Z Z ) 

LD  A, ( I  X) 

CP  TRUE 
JP  Z , OB .  1 
CP  FALSE 
JP  Z  ,  OB . 2 
JP  OB. 3 

OB.  1:  LD  DE,  $BL.  5 

JP  OB.il 

OB.  2:  LD  DE , $B  L. 6 

JP  OB. 4 

OB.  3:  LD  DE,  $BL.  7 

JP  OB. 5 

OB.  4: 

CALL  PR  C  ON 
CALL  RSTREG 
RET 

OB. 5:  CALL  PRCON 

CALL  RSTREG 

RET 

» 

$BL.  5:  DB  •  BOOLEAN  VALUE  =  TRUE  ' 

DB  ODH,OAH,’$* 

$B  L.  6:  DB  *  BOOLEAN  VALUE  =  FALSE  ' 

DB  ODH, OAH ,  ' 

$B  L.  7:  DB  'TYP  NOT  BOOLN,  OR  VALUE  NOT  T/ F  $ 


CHKBUL: 

LD  A , ( T  YP  +Z  Z ) 
AND  OF  OH 
CP  BOOLN 
RET 


GET  10: 

{GETS  1  INHERITED  NODE  FROM  INHSTK 
{AND  DEFINES  ZZ  H DR  B LC K 
CALL  SAVREG 
LD  BC,  1 

LD  (NINH+ATR )  ,BC 
LD  BC ,  0 

LD  (NSYN+ATR) ,BC 
LD  BC.ZATR 
LD  (DESC+ATR  )  ,BC 
CALL  GETATR 
{COPY  HDR  INFO  TO  ZZ 


LD  HL  ,  ( Z ATR  ) 
LD  DE , ZZ 
LD  BC,  1  1 
LD  IR 

CALL  RSTREG 
RET 


GET01  : 

{GETS  1  SYN.  ATTR.  INDEX  OFF  INHSTK 
; DEF I NES  ONLY  IDX  IN  ZZ 
CALL  SAVREG 
LD  BC , 0 

LD  (N INH+ATR  )  ,  BC 
LD  BC,  1 

LD  (NSYN+ATR  )  ,BC 
LD  BC.ZATR 
LD  (DESC+ATR ) , BC 
CALL  GETATR 
;CO PY  IDX 

LD  HL, ( ZATR  ) 

LD  DE.ZZ 

LDI 

LDI 

CALL  RSTREG 
RET 


99999999999999999999999999999999 

ALOCZ  : 

ALLOCATES  ONE  NODE  (Z)  USING  INFO 
;  I N  ZZ.  THEN  SAVES  ALL  H  DR  INFO  INZZ 
CALL  SAVREG 
LD  DE.IDX+HDR 
LD  HL , Z Z 
LD  B C ,  5 
LD  IR 

CALL  ALLOC 

;  N  OW  SWITCH  DE ,  HL  AND  COPY  BACK  FROM  ATR  B  LK 
LD  BC ,  6 
EX  DE  ,  HL 
LDIR 

CALL  RSTREG 
RET 


9  9  9  9  9  9 

;  DATA 

•  f  t  f  f  f  1 

BUFFER 

9  9  9  9  9  9  9  9 

AREAS 

ZATR : 

DW 

0 

ZZ: 

DS 

12 

CHCNT: 

DB 

0 

INPBUF 

:  DS 

OFF  H 

;  6  OCT  83 

;  21  DEC  83  -  REMOVED  DEADWOOD  MODULES  AND  STORAGE  AREAS 
;  02  FEB  84  -  FIXED  NORMAL 

;  06  FEB  84  -  FIXED  ALOCZ  TO  STORE  +0  FOR  ZERO  NUMERIC  NOD 

• 

TITLE  MATH  A/O  06  FEB  84 

GLOBAL  AD,  SB  ,  ML,  DV 
GLOBAL  AB , N  G, I  NT 
EXTERNAL  GETATR, ALOSYN, ATR, HDR 
EXTERNAL  CMPNUM 

EXTERNAL  ALLOC,  PR  LI NE , SA VR E G ,  RSTR EG 
.  XL  1ST 

MACLIB  EQATMO 
EQUATES 

.  LIST 

WHL  EQU  LST+2 
FRC  EQU  WHL+1 
TOT  EQU  FRC+1 
MSB  EQU  TOT  +  1 


99999999999999999999999999999999 

AD:  LD  A, 00H 

JP  OP.  0 

SB:  LD  A,  1  OH 

JP  OP.  0 

; ESTABLISH  OPCODE  FROM  OPERAND  PROPERTIES 

OP.O:  LD  (OPCODE), A 

{PRESET  RESULT  TYP  TO  POSFXP,  AND  OPFLG  TO 
LD  A, POSFXP 
LD  (TYP+ZZ)  ,  A 
LD  A  ,  '+  * 

LD  (OPFLG), A 

{UNSTACK  3  NODE  INDICES  FROM  INHSTK  (X,Y,Z) 
CALL  GET  X  YZ 

{LOOK  AT  SIGNS  OF  X,  Y  TO  FURTHER  DEFINE  OPCODE 
LD  A , ( XX  +T  YP ) 

AND  02H 

;IF  X>0,  ADD  4,  ELSE  ADD  NOTHING 
JP  Z.OP.OI 
LD  A, (OPCODE) 

ADD  A, 4 
LD  (OPCODE), A 

OP. 01:  LD  A  ,  (  YY  +T  YP  ) 

AND  02H 

{IF  Y>0 ,  ADD  2,  ELSE  ADD  NOTHING 
LD  A, (OPCODE) 

JP  Z , OP. 02 
ADD  A, 2 


0  P.  02 


LD  (OPCODE), A 


; TH IS  IS  THE  ADD/SUB  SECTION 

;  C  ALL  COMPAR:  IF  !  X  !  <  !  Y  !  ,  ADD  1  TO  OPCODE, 

{AND  SWITCH  IX, IY 

;  SET  I X/Y  TO  ADDRS  OF  X/Y 
LD  I  X,  (XX+ADR  ) 

LD  I Y ,  (  Y  Y  +A  DR  ) 

{TEMPORARILY  SET  BOTH  TYP’S  TO  POSFXP 
LD  A,  POSFXP 
LD  (IX+TYP)  ,  A 
LD  ( I Y+T  YP  )  ,  A 
CALL  CMPNUM 

{RESTORE  NODE  TYPES 

LD  A , ( XX  +T  YP  ) 

LD  (IX+TYP), A 
LD  A , ( YY  +T  YP  ) 

LD  (IY+TYP)  ,A 
LD  A, (OPCODE) 

LD  IX, XX 
LD  IY.YY 
JP  P, OP.  10 
ADD  A,  1 
LD  IX, YY 
LD  I Y, XX 

OP.  10:  LD  (OPCODE  )  ,A 

{IF  OPCODE  =000001  1X  OR  0001010X,  RESULT  IS  POS,  ADD  X,  Y. 
CP  00000  1  1  IB 
JP  Z , OP.  1 1 
CP  000001  1  OB 
JP  Z , OP.  1 1 
CP  000 1 0 1 0 1 B 
JP  Z , OP.  1 1 
CP  000 1 0 1 0  OB 
JP  Z , OP.  1  1 

{IF  OPCODE =0000000X  OR  0001001X,  RESULT  IS  NEG,  ADD  X, Y. 

CP  0000000  OB 
JP  Z , OP. 12 
CP  0000000  IB 
JP  Z , OP.  12 
CP  000 1 00  1  OB 
JP  Z , OP.  12 
CP  0001001  IB 
JP  Z , OP.  12 

;IF  OPCODErOOOOOlOO  OR  00010110,  RESULT  POS.,  SUBTRACT  X-Y 
CP  00000 1 OOB 
JP  Z , OP.  13 
CP  0000001  IB 
JP  Z , OP.  13 
CP  00010  1  1  OB 


JP  Z,OP.  13 

CP  000 1 000 1 B 
JP  Z,0  P.  1  3 

; F  OR  ALL  OTHER  OPS,  RESULT  NEG,  SUB  X, Y 

;ADJUST  RESULT  TYP,  OPFLG  BEFORE  ADD/SUB 

OP.  14:  LD  A,  NEGFXP 

LD  (T  YP  +Z  Z)  ,  A 

OP.  1  3:  LD  A,  • 

LD  (OPFLG), A 
JP  OP.  20 

OP.  12:  LD  A,  NEGFXP 

LD  (T  YP  +Z  Z)  ,  A 

OP.  1  1:  JP  OP. 20 

OP.  20: 

;  M  A  KE  ZFRC  LARGER  OF  XFRC.YFRC;  PUSH  (XFRC-YFRC) 
LD  B  ,  (IX+FRC ) 

LD  C,  (  IY+FRC) 

LD  A,  B 
CP  C 
LD  A,  C 
JP  M , OP. 21 
LD  A ,  B 

OP.  21  :  LD  (  ZZ+FRC)  ,  A 
LD  L,  A 

;  (S  PC  +H  DR  )  s  L  +  LARGER  OF  XWHL.YWHL  +3 
LD  B  ,  ( I X  +WHL  ) 

LD  C  ,  (  I  Y+W  HL  ) 

LD  A,  B 
CP  C 
LD  A,  C 
JP  M , OP. 22 
LD  A ,  B 

OP. 22:  INC  A 

LD  (  ZZ  +W  HL  )  ,  A 
ADD  A , L 
LD  (TOT+ZZ)  ,  A 

;Z  ERO  OUT  THE  Z  NODE 
LD  HL, RESULT 
LD  (  M  SB  +Z  Z)  ,  H  L 
CALL  ZEROZ 

;C0 PY  X->Z 

CALL  COPYXZ 

; A L IGN  Y  AND  Z  FOR  ADD/SUB 
LD  HL , ( LS T+Z  Z ) 

LD  A.CFRC+ZZ) 

SUB  (FRC+IY) 

LD  C ,  A 
LD  B,  0 
OR  0 

SBC  HL.BC 
EX  DE,  HL 
LD  L , ( I Y+LS T  ) 


LD  H, (IY+LST+1  ) 

LD  C,  (IY+TOT) 

;  R  EA  DY  TO  CALL  BCDADD/SUB,  DEPENDING  ON 
LD  A , (0  PF LG  ) 

CP  ’+  » 

JP  NZ , OP. 30 
CALL  BCDADD 
JP  OP.  31 

OP. 30:  CALL  BCDSUB 

OP.  31  : 

; R  EM  OVE  ANY  LE A DI NG , TR A  I  LI NG  ZEROS 
CALL  NORMAL 

;STORE  RESULT 

CALL  ALOCZ 
CALL  STRSLT 
RET 


ML: 

;  Z  =  X  *  Y  (DECIMAL  FRACTIONS  ALLOWED) 
CALL  GETXYZ 
LD  IX, XX 
LD  IY.YY 
LD  A , ( I X+W  HL ) 

ADD  A  ,  ( I Y  +W H L  ) 

INC  A 

LD  (ZZ+WHL)  ,  A 
LD  B,  A 

LD  A , ( I X+F  RC ) 

ADD  A, ( I Y  +F  RC ) 

LD  (ZZ+FRC)  ,  A 
ADD  A , B 
LD  ( ZZ  +T  OT  )  ,  A 
LD  HL, RESULT 
LD  (MSB+ZZ) , HL 
CALL  ZEROZ 

;SET  DE  TO  PT.  TO  LST  OF  Z,  HL  TO  LSB  OF 

;  I Y  TO  LST  OF  Y 

;C=#  OF  BYTES  IN  X,  B  =  #  OF  BYTES  IN  Y 
LD  DE , ( ZZ  +LST ) 

LD  HL,(XX+LST) 

LD  C , ( I X  +TOT  ) 

LD  B , ( I Y  +T OT  ) 

LD  I Y , ( YY  +LST ) 

;TH IS  IS  THE  BIG  MULTIPLY  LOOP,  REPEATED 

MUL.2:  DEC  B 

JP  M , MUL. 4 
LD  (TEMP) , BC 

;LET  B=0  OF  TIMES  TO  ADD  X  TO  Z 
LD  A,  (IY) 

CALL  BCDHEX 
LD  B,  A 


(OPFLG) 


X 


NY  TIMES 


MUL.  3 


:  DEC  B 

JP  M, MUL. 31 
CALL  BCDADD 
JP  MUL.  3 
MUL. 31:  LD  BC,  (TEMP) 

DEC  IY 
DEC  DE 
JP  MUL.  2 
; A LL  DONE 
MUL.  4: 

{ R  EM  0  VE  ANY  LE A DI NG , TR A IL I NG  ZEROS 
CALL  NORMAL 
{STORE  RESULT 

CALL  SIGNMD 
CALL  ALOCZ 
CALL  STRSLT 
RET 


DV: 

;  Z  =  X  /  Y  (DECIMAL  FRACTIONS  ALLOWED) 
CALL  GETXYZ 
LD  IX, XX 
LD  IY.YY 

{ESTIMATE  //  OF  LEAD  ZEROES  IN  Z=WY~WX 
LD  A , ( IY  +WHL ) 

SUB  (IX+WHL) 

DEC  A 

{COUNT  LEAD  ZEROES  IN  Y:  DEC  LZ 
LD  BC , (TOT  +YY) 

LD  B,  A 

LD  HL , ( MSB  +Y Y ) 

DV.OO:  DEC  C 

JP  M , DV. 01 
LD  A , ( HL  ) 

CP  0 

JP  NZ , DV. 01 
DEC  B 
INC  HL 
JP  DV.OO 
DV.01:  INC  C 

LD  A,  C 

LD  ( T OT+Y  Y  )  ,  A 
LD  (MSB  +YY ) , H  L 

{NOW  LOOK  FOR  LEAD  ZEROES  IN  X:  INC  LZ 
LD  H L , ( M SB  +XX ) 

LD  A , ( T OT  +X X  ) 

LD  C ,  A 
:  DEC  C 

JP  M , DV. 03 
LD  A  ,  ( HL  ) 


D  V.  02 


JP  NZ , D  V. 0 3 
INC  B 
INC  HL 
JP  DV. 02 
D V. 03:  INC  C 
LD  A,  C 

LD  (TOT+XX)  ,  A 
LD  (MSB  +XX )  ,HL 
;WZ=E=-LZ,  FZ  =D  =LZ+NSIG-WZ 
LD  A,  0 
SUB  B 
LD  E,  A 

{ SET  E,B  TO  0  IF  NEG. 

LD  A,  0 
CP  B 

JP  M  ,  DV. 21 
LD  B,  0 

DV.21: 

CP  E 

JP  M, DV. 23 
LD  E,  0 
DV.23:  LD  A ,  B 

LD  (LZ)  ,  A 
LD  A ,  ( NS IG  ) 

ADD  A ,  B 
SUB  E 
JP  P,  DV. 24 
LD  A,  0 

DV. 24:  LD  ( FRC+ZZ)  ,  A 

LD  A,  E 

LD  (WHL+ZZ)  , A 

;  LEA  VE  LZ+3  LEAD  ZEROES  IN  RESULT 
LD  HL, RESULT 
LD  BC, (LZ) 

LD  B,  0 

LD  IX, RESULT 
ADD  IX, BC 
INC  BC 
INC  BC 

LD  DE , RESULT  +  1 
LD  ( HL ) , 0 
LDIR 

LD  ( MSB  +Z  Z )  ,  DE 
{COPY  X  =>  RESULT 

LD  HL, ( MSB+XX ) 

LD  BC, (TOT+XX) 

LD  B,  0 
DEC  C 

JP  M  ,  DV.  41 
INC  C 
LDIR 


DV.  4  1 


;  LEA  VE  NSIG-XTOT  MORE  ZEROES  IN  RESULT 
EX  DE,  HL 
LD  A , ( NS IG  ) 

LD  BC , (TOT+XX ) 

SUB  C 

JP  M , DV. 43 
JP  Z.DV.43 
DV.42:  DEC  A 

JP  M, DV. 43 
LD  ( HL ) , 0 
INC  HL 
JP  DV.42 

DV.  43: 

;  I X  PTS  TO  RESULT  BYTES  IN  Z 

;MIN  ( YTOT,  NSIG )  =  if  OF  BYTES  TO  SUB  Y  FROM  Z 
LD  A, (NSIG) 

LD  BC, (TOT+XX) 

CP  C 

JP  P,  DV.  44 
LD  A,  C 

DV.44:  INC  A 

LD  (TSIG ) , A 
DV.50:  LD  A, (TSIG) 

DEC  A 

JP  Z , DV. 59 
LD  (TSIG), A 
CP  (IY+TOT) 

JP  M.DV.51 
LD  A, (YY+TOT) 

DV.51:  LD  C ,  A 

; S ET  HL/DE  TO  LST  OF  Y/RESULT 
LD  B,  0 
{UPDATE  MSBZ 

LD  HL,  (  ZZ+MSB) 

INC  HL 

LD  (ZZ+MSB)  ,  HL 
OR  0 

ADC  HL ,  BC 
DEC  HL 
DEC  HL 
EX  DE, HL 
LD  HL ,  (  MSB  +Y  Y  ) 

OR  0 

ADC  HL ,  BC 
DEC  HL 

; N OW  READY  TO  ENTER  SUB  LOOP 
LD  (IX), 0 
LD  (I X+1 ) , 0 

DV.  54: 

CALL  BCDSUB 
JP  C  ,  D  V.  5  5 
INC  (IX) 

JP  DV.54 


{ADD  Y  BACK  TO  Z  ONCE 
DV.  55: 

CALL  BCDADD 
LD  A,  (IX ) 

CALL  HE XI 00 
LD  (IX), A 
INC  IX 
JP  DV.50 

DV.  59: 

; R  EM  0 VE  ANY  LE A DI NG , TR A IL I NG  ZEROS 
CALL  NORMAL 
{STORE  RESULT 

CALL  SIGNMD 
CALL  ALOCZ 
CALL  STRSLT 
RET 


AB  : 

{ABSOLUTE  VALUE 

CALL  GET  XZ 
LD  A,  POSFXP 
LD  (T  YP  +Z  Z)  ,  A 
CALL  IDXZ 


NG: 

{NEGATION 

CALL  GETXZ 
LD  A , (T YP  +XX ) 
CP  POSFXP 
LD  A.NEGFXP 
JP  Z , NG.  1 
LD  A, POSFXP 
NG.  1:  LD  (TYP+ZZ)  ,  A 

CALL  IDXZ 
RET 


INT: 

{RETURNS  INTEGER  PART 
CALL  GETXZ 
LD  A,  0 

LD  (FRC+XX) ,A 
LD  A , (T YP  +XX ) 
LD  (TYP+ZZ)  ,  A 
CALL  IDXZ 


HEX100: 

;  C  ON  VE  R  TS  HEX  it  IN  A  TO  DECIMAL 
LD  C ,  A 
LD  A,  0 

HEX.  Is  DEC  C 

JP  M,  HEX.  2 
ADD  A, 1 
DA  A 

JP  HEX.  1 
HEX.  2:  RET 


• 

SIGNMD: 

{SETS  SIGN 

OF  RESULT  OF  MUL/DIV 

LD 

A,  (TYP+XX  ) 

LD 

BC,  (  TYP+YY  ) 

CP 

C 

LD 

A,  POSFXP 

JP 

Z,  SMD.  1 

LD 

A,  NEGFXP 

SMD.  1: 

LD 

(TYP+ZZ)  ,  A 

RET 

• 

f 

ifMiiiiiiiiiiiMiilt 

GET XZ  : 

;GETS  X,  Z  : 

1  INHER. ,  1  SYNTH. 

CALL  SAVREG 

LD 

BC,  1 

LD 

(N INH+ATR ) , BC 

LD 

(NSYN+ATR)  , B  C 

LD 

BC, YATR 

LD 

I  X,  YATR 

JP 

GT.  0 

GETXYZ  : 

{DEFINES  16  BYTES  OF  DESCRIPTOR  BLK  OF 
; X, Y  AND  DEFINES  INDEX  OF  Z 
CALL  SAVREG 
LD  BC ,  2 

LD  (N INH+ATR  )  ,  BC 
LD  BC,  1 

LD  (NSYN+ATR)  ,BC 
LD  BC, XATR 
LD  IX, XATR 

GT.  0: 

LD  (DESC+ATR ) , BC 
CALL  GETATR 


;C0 PY  H DR  BLKS  OF  X,  Y  TO  XX,  YY 
;  A  ND  DEFINE  OTHER  FIXED  PT  PARAMETERS 
LD  BC, (NINH+ATR  ) 

CALL  STL U P  1 
LD  I  Y,  XX 
LD  DE, XX 

GT.  1 :  CALL  LUP  1 

JP  M, GT. 2 
LD  L ,  (IX) 

LD  H, ( I X+1 ) 

;COPY  11  BYTES  FROM  ATRBLK  TO  LOCAL 
LD  BC,  1 1 
LDIR 

-.DEFINE  OTHER  PARAMS 
LD  L , ( I Y  +FST ) 

LD  H,  (  I  Y+FST  +  1  ) 

LD  A  ,  (HL ) 

LDI 

ADD  A,  (HL) 

LDI 

LD  (DE  )  , A 

;HL  PTS  TO  MSB  OF  NUMBR 
LD  ( I Y+M  SB )  ,  L 
LD  ( I Y  +M  SB  +1  )  ,  H 
;STORE  LST  BYTE  OF  # 

LD  C ,  A 
LD  B,  0 
OR  0 

ADC  HL ,  BC 
DEC  HL 

LD  (IY+LST) ,L 
LD  ( I Y  +LST  +  1 ) , H 
{REPEATED  ONLY  ONCE  MORE 
LD  IX.YATR 
LD  IY, YY 
LD  DE, YY 
JP  GT .  1 

GT.  2: 

LD  HL, ( ZATR  ) 

LD  DE, Z  Z 

LDI 

LDI 

CALL  RSTREG 
RET 


I  DXZ  : 

{MAKES  IDENTICAL  COPY,  EXCEPT  FOR  TYPE 
LD  BC  ,  ( WHL  +  XX ) 

LD  (WHL+ZZ) , BC 
CALL  ALOCZ 
LD  BC,  (TOT+ZZ) 


V'. 


: 


%  % 


v\- 


*?- 


ft: 


y 
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to 


to 


m 
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LD  B ,  0 
LD  A,  0 
CP  C 

JP  P,  IDXZ .  1 
LD  H L , ( M SB  +XX ) 
LD  DE,  (  MSB+ZZ) 
LDIR 

IDXZ. 1 :  RET 


A  LOC  Z  : 

;  A  LLOC  ATES  RESULT  (ZZ),  AND  STORES  WHL.FRC 
CALL  SAVREG 
LD  BC , ( WHL+Z  Z ) 

LD  A,  B 
ADD  A,  C 
CP  0 

JP  NZ.AL.1 

INC  A 

LD  ( WHL  +Z  Z)  ,  A 

LD  (TOT+ZZ) , A 
1 

NZ.AL.2 
A, (RESULT) 

0 

NZ, AL. 2 
A, POSFXP 
(TYP+ZZ)  ,  A 
A,  (TOT+ZZ) 


DIGITS 


2/6  CHECK  FOR 
2/6 

2/6  IF  NO  DIGITS,  ADD  ON 
2/6  STORE  1  IN  WHL 


AL.  1: 


AL.  2: 


C  P 
JP 
LD 
CP 
JP 
LD 
LD 
LD 
INC  A 
INC  A 
LD  C,  A 
LD  B,  0 

LD  (SPC+ZZ)  ,  BC 
LD  DE.IDX+HDR 
LD  HL.ZZ 
LD  BC, 5 
LDIR 

CALL  ALLOC 
EX  D  E , H  L 
LD  BC, 6 
LDIR 

{STORE  WHL.FRC  IN  Z  NODE 
LD  DE , ( ZZ  +FST ) 

LD  HL.ZZ+WHL 

LDI 

LDI 

{STORE  MSB  (DE)  A  DDR  LOCALLY 
LD  (MSB+ZZ)  ,  DE 
CALL  RSTREG 
RET 


2/6  ONLY  ONE  DIGIT? 

2/6 

2/6  GET  1ST  BYTE  OF  RESU 
2/6  IS  DATA  BYTE  ZERO? 
2/6 

2/6  IF  YES  ENSURE  +0 
2/6 
2/6 


y.  • .  v  . 

.  A 


.  • .  •' 


JW  ft.  J  ■ 


La 


STRSLT : 

{COPIES  RESULT  TO  Z  NODE 
CALL  SAVREG 
LD  DE , ( MSB  +Z  Z ) 

LD  HL, RESULT 
LD  BC , (TOT+ZZ) 

LD  B ,  0 
DEC  C 
JP  M , ST.  1 
INC  C 
LD  I R 

ST. 1 :  CALL  RSTREG 

RET 


ZEROZ  : 

{ZEROS  (TOT+ZZ)  BYTES  OF  Z  NODE 
CALL  SAVREG 
LD  HL, ( MSB+ZZ) 

LD  DE, (MSB+ZZ) 

INC  DE 
LD  ( HL )  ,  0 
LD  BC, (TOT+ZZ) 

DEC  C 

JP  M, ZRO.  1 
JP  Z,  ZRO.  1 
LD  B,  0 
LDIR 

ZRO.  1 : 

LD  (LST+ZZ)  ,  HL 
CALL  RSTREG 
RET 


COPYXZ  : 

{COPIES  X  ->  Z,  ALIGNING  DECIMAL 
CALL  SAVREG 
LD  DE, (MSB+ZZ) 

INC  DE 

LD  C  ,  (  T  OT  +1  X  ) 

LD  B ,  0 

LD  L , ( MSB  +1 X ) 

LD  H ,  (  M  SB  +1 X  +1  ) 

LDIR 

CALL  RSTREG 
RET 


PO INTS 


B  C  DA DD 


{ A  DDS  2  BCD  NUMBERS,  ONE  IN  Z  NODE,  OTHER  IN  Y 
;DE/HL  PT.  TO  LAST  BYTES  OF  Z,Y 
;C  =  #  OF  BYTES  TO  ADD 
CALL  SAVREG 
OR  0 

BCAD.O:  DEC  C 

JP  M  ,  BCAD.  1 
LD  A , (DE ) 

A  DC  A ,  (  H  L  ) 

DAA 

LD  (DE  )  ,  A 
DEC  HL 
DEC  DE 
JP  BCAD.  0 
BCAD.  1:  LD  A,  (  DE  ) 

ADC  A ,  0 
DAA 

LD  ( DE  )  ,  A 
DEC  DE 
JP  C, BCAD.  1 
BCAD. 2:  CALL  RSTREG 
RET 


BCDSUB: 

{SAME  AS  BCDADD,  EYCEPT  SUBTRACT 
CALL  SAVREG 
OR  0 

BCSB.O:  DEC  C 

JP  M , BCSB ,  1 
LD  A , ( DE ) 

SBC  A , ( H L  ) 

DAA 

LD  (DE  )  , A 
DEC  HL 
DEC  DE 
JP  BCSB.O 
BCSB. 1:  LD  A, (DE) 

SBC  A, 0 
DAA 

LD  ( DE  )  ,  A 

BCSB. 2:  CALL  RSTREG 
RET 


BCDHEX: 

{CONVERTS  2  BCD  DIGITS  IN  A  TO  HEX 
CALL  SAVREG 
LD  HL, DUM 
LD  ( HL ) , A 
XOR  A 


BH.  1: 


BH.  2: 


DUM  : 


LD  C,  A 
XOR  A 
DEC  C 
JP  M, BH. 2 
ADD  A, 1 0 
JP  BH. 1 
LD  C ,  A 
XOR  A 
RLD 

ADD  A,  C 
CALL  RSTREG 
RET 

DB  0 


NORMAL: 

;  R  EM  OVES  LEADING/TRAILING  ZEROES  FROM  RESULT  (Z) 
CALL  SAVREG 
LD  HL, RESULT 
LD  B C , ( WHL  +Z  Z  ) 

;TAKE  OFF  ANY  LEADING  ZERO'S 
NM.  1 :  DEC  C 


NM.  2: 


DEC  C 

JP  M, NM. 

2 

LD  A  ,  ( HL  ) 

CP  0 

JP  NZ.NM 
INC  HL 

.  2 

JP  NM.  1 
INC 

C 

LD 

A,  C 

2/2 

LD  ( WHL  +Z  Z)  ,  A 

ADD  A,  B 
LD  C,  A 
DEC  C 

JP 

P,  NM  .  3 

2/2 

JP 

Z,  NM.  3 

2/2 

LD 

(HL)  ,  0 

2/2 

INC 

C 

2/2 

LD 

A,  1 

2/2 

LD 

(WHL+ZZ)  ,  A 

2/2 

INC 

C 

2/2 

LD  DE, RESULT 

LD  B,  0 
LDIR 

NM.  3: 


;CHECK  FOR  ANY  TRAILING  ZERO'S 
EX  DE,HL 
DEC  HL 

LD  BC , ( WHL  +Z  Z ) 

:  DEC  B 

JP  M , NM . 6 
LD  A  ,  ( HL  ) 


NM.  5 


NM.  7 


LD  A,  B 

LD  (FRC+ZZ)  ,  A 
CALL  RSTREG 
RET 


• 

STLUP1: 

LD  ( CLUP 1 ) , BC 

RET 

LUP  1 : 

LD  (TEMP)  ,  BC 
LD  BC,(CLUP1 ) 
DEC  C 

JP  P.LUP11 

DEC  B 

LUP1 1 : 

• 

9 

LD  (CLUPI).BC 
LD  B C  ,  ( T EM P ) 
RET 

9  9  9  9  9  9  9 

• 

9 

9  9  9  9  9  9 

99999999 

• 

9 

XATR : 

DW 

.  LIST 
0 

YATR  : 

DW 

0 

ZATR: 

DW 

0 

XX: 

DS 

16 

YY: 

DS 

1  6 

III 

DS 

16 

OPCODE: 

DB 

0 

OPFLG: 

DB 

0 

CLUP  1 : 

DW 

0 

TEM  P: 

DW 

0 

AFTEMP: 

DW 

0 

HLTEM  P: 

DW 

0 

LZ: 

DW 

0 

NSIG: 

DW 

4 

TSIG: 

DW 

0 

RESULT: 

DS 

256 

END 

:END  OF 

MATH. 

;  6  OCT  83 

;  29  NOV  83  -  MADE  ALL  R ST  38H  RETURN  TO  FORTH 
;  21  DEC  83  -  REMOVED  ALL  DEADWOOD  MODULES  AND  STORAGE  ARE 

TITLE  RADX  A/O  21  DEC  83 

GLOBAL  BCDASC, ASCBCD 
GLOBAL  HEXASC,  HE  XWR  D,  ASCHEX 
GLOBAL  HEXBCD,  BCDHEX,  HEXIOO 
EXTERNAL  SA VRE G, RSTREG 
EXTERNAL  PR  LI  N  E 

.  XL  I S  T 

MACLIB  EQATMO 

.  LIST 

jBCDASC  AND  ASCBCD  CONVERT  BETWEEN  STRINGS 
;  OF  ASCII  CHARS.  0-9  AND  BCD  NUMBERS 
;  UPON  ENTRY  AND  EXIT. . 

;  BC=#  OF  DIGITS  TO  BE  CONVERTED 
;  HL  =PT R  TO  STRING  OF  PACKED  BCD  DIGITS 
;  DE=PTR  TO  STRING  OF  ASCII  CHARACTERS 

ASCBCD: 

CALL  SAVREG 
ASBC . 1:  DEC  C 

JP  M.ASBC.2 
LD  A  ,  (  DE  ) 

INC  DE 
SUB  3  OH 
CALL  RNGCHK 
R  LD 

LD  A, (DE  ) 

INC  DE 
SUB  30H 
CALL  RNGCHK 
RLD 

INC  HL 
JP  ASBC.  1 

ASBC. 2:  CALL  RSTREG 
RET 


BCDASC  : 

CALL  SAVREG 
LD  (TEMP) , DE 
LD  I  Xf  (  TEM  P  ) 
BCAS. 1:  DEC  C 

JP  M , BCAS. 2 
XOR  A 
LD  D , ( H  L ) 


CALL  RNGCHK 
ADD  A ,  3  OH 
LD  (I X  +  1  )  ,  A 
XOR  A 
RRD 

CALL  RNGCHK 
ADD  A,  3  OH 
LD  (IX), A 
LD  (HL),D 
INC  IX 
INC  IX 
INC  HL 
JP  BCAS. 1 

B C AS . 2:  CALL  RSTREG 
RET 


RNGCHK: 

{CHECKS  THAT  DIGIT  IN  RNG  0-9 
CP  10 
JP  P, RC.  1 
CP  0 

JP  M, RC.  1 
RET 

RC. 1:  LD  DE, $RC. 1 

CALL  PR  LI NE 

RET  ;  11/29 

$RC.1:  DB  'CHAR  OR  NUM  OUT  OF  RANGE  (0-9)  $' 


M  )  M  f  M  M  f  I  M  t  f  I  t  >  f  »  f  t  M  f  M  f  M  I  t 

HEXASC  : 

{CONVERTS  AN  N-BYTE  STRING  OF  HEX  VALUES 
;T0  A  2N-BYTE  STRING  OF  ASCII  CHARACTERS 
;BC=N,  DE  PTS  TO  BUFFER  FOR  ASCII  CHARS, 
{HL  PTS  TO  FIRST  HEX  BYTE 
CALL  SAVREG 
LD  ( TEMP ) , DE 
LD  IY, ( TEM  P) 

HXAS.O:  DEC  C 

JP  M,  HXAS.  3 
LD  (IY)  ,'  ' 

INC  IY 
CALL  HXCONV 
HXAS.  1:  LD  ( I Y  +1  )  ,  A 
CALL  HXCONV 
HXAS. 2:  LD  (IY),A 
INC  IY 


INC  HL 
JP  HXAS.O 

HXAS.  3:  CALL  RSTREG 
RET 


HEXWRD: 

{CONVERTS  AN  N-BYTE  STRING  OF  HEX  VALUES  TO 
; A  2N-BYTE  STRING  OF  ASCII  CHARACTERS 
{BYTES  DISPLAYED  AS  HEX  WORDS 
;BC=N,  DE  PTS  TO  BUFFER  FOR  ASCII  CHARS, 

{HL  PTS  TO  FIRST  HEX  BYTE 
CALL  SAVREG 
LD  (TEMP)  ,  DE 
LD  I Y , (TEMP ) 

HXWD.  0: 

DEC  C 

JP  M,  HXWD.  3 
LD  (IY)  ,  '  • 

INC  IY 
INC  HL 
LD  E, (HL) 

CALL  HXCONV 
HXWD.  1:  LD  ( I  Y  +  1  )  ,  A 
CALL  HXCONV 
HXWD. 2:  LD  ( I  Y  )  ,  A 
INC  IY 
INC  IY 
LD  (HL )  ,  E 
DEC  HL 
LD  E  ,  ( HL  ) 

CALL  HXCONV 
LD  ( I Y  +1  )  ,  A 
CALL  HXCONV 
LD  ( I Y )  ,  A 
INC  IY 
INC  IY 
LD  (H  L  )  ,  E 
INC  HL 
INC  HL 
JP  H  XWD.  0 

HXWD.  3: 

LD  (IY)  1 
CALL  RSTREG 
RET 

9 

•  •••••••••••••••••••••••••*••••• 

99999999999999999999999999999999 

HXCONV: 

{DOES  ACTUAL  CONVERSION  OF  NIBBLES  IN  (HL) 
XOR  A 


ADD  A , 3  OH 
CP  3AH 
RET  M 
ADD  A,  7 
RET 


ASCHEX: 

;  C  ON  VE  R  TS  A  2N-BYTE  STRING  OF  ASCII  CHARACTERS 
;TO  AN  N-BYTE  STRING  OF  HEX  BYTES 
;  B  C  =2N ,  DE  PTS  TO  BUFFER  FOR  HEX  BYTES, 

;HL  POINTS  TO  ASCII  CHARACTERS 
CALL  SAVREG 
LD  (TEMP) , HL 
LD  I Y , ( T EM  P ) 

EX  DE,  HL 
SRL  C 

ASH  X. 0: 

DEC  C 

JP  M , ASH X.  3 
LD  A,  ( I Y  +1  ) 

SUB  30H 
CP  1  1H 
JP  M , ASH X.  1 
SUB  7 

ASH  X,  1 :  RR  D 

LD  A, ( IY) 

SUB  3  OH 
CP  1  1H 
JP  M , ASH X. 2 
SUB  7 

ASH  X. 2:  RR  D 

INC  IY 
INC  IY 
INC  HL 
JP  ASH  X. 0 

ASH  X. 3: 

CALL  RSTREG 
RET 


;HEXBCD:  CONVERTS  2-BYTE  HEX  NUMBER  TO  3-BYTE  BCD  NUMBER 
;BC  DHE  X:  DOES  REVERSE 

;  H  E  XI 00  CONVERTS  HEX  BYTE  (IN  A)  TO  DEC.  BYTE 
HEXBCD: 

;UPON  ENTRY  HL=HE  X  NUMBER, 

; DE  PTS  TO  BUFFER  FOR  3  BCD  DIGITS 
CALL  SAVREG 

;  P  1 0TAB  IS  A  TABLE  OF  POWERS  OF  TEN 
LD  I Y, P 1 OTAB 


LD  (TEMP ) , DE 
EX  DE  ,  HL 
LD  ( HL )  ,  0 
LD  C,  5 

HB.O:  EX  DE,  HL 

XOR  A 
LD  E, ( I Y) 

LD  D, (IY+1 ) 

HB.  1 :  OR  A 

SUBTRACT  POWER  OF  TEN 
SBC  H  L,  DE 

;KEEP  DIVIDING  UNTIL  NC 
JP  C.HB.2 
INC  A 
JP  HB.  1 

{RESTORE  HL  TO  POS. 

HB.  2:  ADD  HL,  DE 

{SAVE  BCD  DIGIT 
EX  DE,  H L 
LD  HL,  (TEMP) 

R  LD 

BIT  O.C 
JP  Z, HB. 3 
INC  HL 
LD  ( HL )  ,  0 

HB  .  3:  LD  (TEM  P) , HL 

INC  IY 
INC  IY 
DEC  C 

JP  NZ.HB.O 
CALL  RSTREG 
RET 


BCDHEX: 

{CONVERTS  UP  TO  3  BCD  BYTES  TO  A  16-BIT  HEX  # 
{ON  RETURN,  DE  PTS  TO  HEX  # 

{FIRST  BYTE,  C  =  //  OF  BYTES,  0<C<=3 
{CHECK  C 

CALL  SAVREG 
LD  A,  C 
CP  0 

JP  Z,  BCHX.  8 
CP  4 

JP  P,  BCHX.  8 

{LET  HL  PT  TO  LAST  BYTE 
LD  B,  0 
ADD  HL.BC 

{HL’  =  ACCUMULATOR,  ZERO  IT 
EXX 

LD  HL, 0 


AND  0 

;LET  IY  PT  TO  POWER  OF  10  TO  ADD 
LD  I  Y,  P  1 OTAB  + 1 0 

;SET  UP  BIG  LOOP  TO  MULTIPLY  BCD  BYTES 

BH.  1:  DEC  C 

JP  M , BH. 6 
DEC  IY 
DEC  IY 
DEC  HL 

;  S  A  VE  BYTE  (HL)  FOR  LATER 
LD  A , (HL  ) 

LD  (TEMP)  ,  A 
LD  A,  0 
RRD 

; GO  TO  HL'  , DE  • 

EXX 

;MA  KE  DE •  THE  ADDEND 
LD  E, ( I Y) 

LD  D,  (IY+1  ) 

BH.2:  DEC  A 

JP  M, BH. 3 
ADC  H L ,  DE 
JP  BH. 2 

BH.3:  DEC  IY 

DEC  IY 
LD  E  ,  ( I Y  ) 

LD  D,  ( IY  +  1  ) 

; PUT  UPPER  4  BITS  IN  A 
LD  A,  0 
EXX 
R  LD 
EXX 

BH.  4:  DEC  A 

JP  M, BH. 5 
ADC  H L,  DE 
JP  BH.4 

; DONE  WITH  THIS  (HL),  RESTORE  IT 

BH.5:  EXX 

LD  A , ( TEM  P ) 

LD  ( HL ) , A 
JP  BH.  1 

BH.6:  EXX 

LD  (HEXNUM)  ,  HL 
EXX 

LD  HL, HEXNUM 

LDI 

LDI 

JP  C, BCHX. 9 

BH.7:  CALL  RSTREG 

RET 

HEXNUM:  DW  0 

BCHX.  8:  LD  DE  ,  $BCHX8 


1  4  6 


JP  QUIT 

BCHX.  9:  LD  DE  ,  $BCHX9 
CALL  PRLINE 
JP  BH. 7 

$BCHX8:  DB  •CANT  CONVERT  >3  OR  <0  BCD  BYTES  TO  HEX  $• 
$BCHX  9:  DB  'HEX  it  >64K  IN  BCDHEX  $' 

QUIT:  CALL  PRLINE 

JP  BH.7  ;  RETURN  TO  FORTH 


HEX100: 

{CONVERTS  HEX  BYTE  IN  A  <  <  1  0  0  ) 

;T0  BCD  BYTE  IN  A 
CP  100 
JP  P.HX.1 
CP  0 

JP  M, HX.  1 

{USE  BCBUF  AND  CALL  HEXBCD 
CALL  SAVREG 
LD  H,  0 
LD  L,  A 
LD  DE.BCBUF 
CALL  HEXBCD 

{RETURN  BCD  BYTE  IN  A 
LD  DE.BCBUF  +  2 
LD  A, ( DE  ) 

CALL  RSTREG 
RET 

• 

HX.  1:  LD  DE,  $H  XI  00 

CALL  PRLINE 
RET 

$H  XI 00:  DB  'HEX  VALUE  OUT  OF  (0-99)  $’ 


TEMP:  DW  0 

P10TAB:  DW  10000 

DW  1000 

DW  100 

DW  10 

DW  1 

• 

HXNUM:  DW  1111 

BCBUF:  DS  3 


;  6  OCT  83 

;  29  NOV  83  -  MADE  ALL  R ST  38H  RETURN  TO  FORTH 
;  21  DEC  83  -  REMOVED  DEADWOOD  MODULES  AND  STORAGE  AREAS 

TITLE  RELN  A/O  21  DEC  83 

GLOBAL  CM  PN  UM  ,  CM  PS  YM  ,  CM  PS  EQ 
GLOBAL  EQ,  NE,  LT,  LE,  GT,  GE 
EXTERNAL  GE TATR , ALOS YN , ATR , HDR 
EXTERNAL  SAVREG.RSTREG,  PR  LINE, FETCH 

.  XL  I S  T 

MACLIB  EQATMO 

EQUATES 

.  LIST 


EQ:  {COMPARES  2  NODES  FOR  EQUALITY 

{  1  )  COMPARE  THEIR  TYPES 

;  2 )  IF  NON-NIL  ATOMS  OR  SEQUENCES,  COMPARE  THEIR  LENGTHS 
;  3  )  IF  ATOMS,  COMPARE  EACH  DIGIT  OR  CHAR 
;4)  IF  SEQUENCE,  COMPARE  EACH  ELEMENT 
{RETURNS  BOOLEAN 

{GET  X,  Y,  Z  NODES,  DEFINE  XX,  YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COMPAR 
JP  NZ.RELNO 

{STATEMENTS  BELOW  ARE  COMMON  TO  ALL  RELN  PRIMITIVES 
RELYES:  LD  A, TRUE 
JP  RELQU 

RELNO:  LD  A, FALSE 

RELQU:  LD  (R  ESTYP  )  ,  A 

{STORE  THE  BOOLEAN  NODE  (Z) 

CALL  STORZ 
RET 

9 

R  ESTYP :  DB  0 


w. 


FV' 


v: 


■r 

V- 


NE 


{COMPARES  2  NODES  FOR  INEQUALITY. 
{CALLS  EQ,  ABOVE,  AND  COMPLEMENTS  RESULT. 

{GET  X,  Y,  Z  NODES,  DEFINE  XX,  YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COMPAR 
JP  NZ, RELYES 
JP  RELNO 


99999999999999999999999999999999 

9 


LT:  ;C  OM  PAR  ES  2  NODES  FOR  'LESS-THAN'  ORDERING  REL 

;GE T  X,  Y,  Z  NODES,  DEFINE  XX,  YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COM  PAR 
JP  M, RELYES 
JP  RELNO 


LE:  {COMPARES  2  NODES  FOR  'LESS-THAN  OR  EQUAL-TO' 

{GET  X,  Y ,  Z  NODES,  DEFINE  XX, YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COM  PAR 
JP  M, RELYES 
JP  Z , RELYES 
JP  RELNO 

99999999999999999999999999999999 

9 

GT:  {COMPARES  2  NODES  FOR  'GR  EATER  -T  HA  N  '  ORDERING. 

{GET  X,  Y,  Z  NODES,  DEFINE  XX, YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COMPAR 
JP  Z, RELNO 
JP  M, RELNO 
JP  RELYES 

99999999999999999999999999999999 

GE:  {COMPARES  2  NODES  FOR  'GR EATER -T HA N  OR 

{EQUAL-TO'  ORDERING. 

{GET  X,  Y,  Z  NODES,  DEFINE  XX,  YY  BLKS 
CALL  XYZBUL 
{COMPARE  X,  Y 

CALL  COMPAR 
JP  M, RELNO 
JP  RELYES 


XYZBUL: 

{GETS  OPERAND  AND  RESULT  INDICES  OFF  INHSTK 
LD  BC, 2 

LD  (N INH+ATR ) , BC 
LD  BC, 1 

LD  (NSYN+ATR)  ,BC 
LD  BC.XATR 
LD  (DESC+ATR ) ,BC 
CALL  GETATR 

{COPY  H DR  BLKS  TO  XX,  YY 
LD  H L , ( XATR ) 

LD  DE.XX 
LD  BC, 1 1 
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LDIR 

LD  HL, (  YATR ) 
LD  D  E , YY 
LD  BC,  1 1 
LDIR 

LD  HL, ( ZATR  ) 

LD  DE,ZZ 

LDI 

LDI 

RET 


STORZ  : 

{ALLOCATES 

NODE  FOR  BOOLEAN  RESULT 

{OF 

RELATIONAL  FUNCTION. 

{SEND  TYP, SPC , IDX  TO  ALLOC 

LD 

A , BOOLN 

LD 

(TYP+ZZ)  ,  A 

LD 

BC,  1 

LD 

(SPC+ZZ)  ,  BC 

LD 

DE.(ZATR) 

LD 

HL,  ZZ 

LD 

BC,  5 

LDIR 

CALL  ALOSYN 

EX 

DE.HL 

LD 

BC,  6 

LDIR 

LD 

IX,  (  ZZ+FST) 

LD 

A,  (RESTYP) 

LD 

(IX)  , A 

RET 

f 

C  OM  PA  R  : 

{COMPARE  X,  Y 

{RETURNS  MINUS  (SIGN  FLAG  SET)  IF  X<Y, 
{ZERO  (Z  FLAG  SET)  IF  X=Y,  OR 
{ >0  (SIGN  SET,  Z  NOT  SET)  IF  X>Y 
{FOR  ATOMS:  NIL<NUMBER<BOOLN<SYMBL<SEQNC 
;ATOM<SEQUENCE 

CALL  SAVREG 

;IF  TYP'S  NOT  EQUAL,  WE  ARE  DONE 
LD  A,  (XX+TYP) 

LD  BC  ,  ( YY  +TYP  ) 

CP  C 

JP  NZ , CP. 40 

{BOTH  OF  SAME  TYPE,  COMPARE  IN  DETAIL 
LD  I  X , ( XX  +A  DR ) 

LD  IY,  (  YY+ADR  ) 

AND  OF  OH 


CP  NUMBR 
JP  Z  ,  CP.  NUM 


CP  SYMBL 
JP  Z.CP.SYM 

CP  SEQNC 
JP  Z.CP.SEQ 

;TYP  NOT  RECOGNIZABLE,  RETURN  ERROR  MSG 
JP  CP. 50 

C  P. NUM  : 

CALL  CMPNUM 
JP  C  P.  40 

C  P.  SYM  : 

CALL  CM  PS  YM 
JP  CP. 40 

CP.  SEQ: 

CALL  CM  PS  EQ 

C  P. 40:  CALL  RSTREG 
RET 


{COMPARE  #  OF  WHL  DIGITS 
CP. 2:  LD  A ,  ( I  X+C  NT  ) 

CP  (IY+CNT) 

JP  NZ  ,  CPN  .  10 

;  IF  LENGTHS  SAME,  COMPARE  EACH  BYTE 
{SAVE  9  OF  DEC  BYTES  IN  HL 
C  P.  3:  LD  L,  ( I X  +C  NT  +  1  ) 

LD  H,  ( I  Y+CNT  +  1  ) 

{MOVE  IX, IY  UP  TO  DATA 
LD  C, ( I X+C NT  ) 

LD  DE ,  7 
ADD  IX,  DE 
ADD  I  Y,  DE 

{LOOP  TO  COMPARE  WHL  BYTES 
CPN.  1:  DEC  C 

JP  M  ,  CPN  .  2 


LD 

A,  (XX+TYP) 

2/1  5 

CP 

NEGFXP 

2/15 

CHECK 

FOR  NEG  // 

JP 

NZ  ,  CP.  5 

2/1  5 

BYBASS 

FOR  POS  # 

LD 

A,  (IX) 

2/15 

CP 

(IY) 

2/1  5 

JP 

Z,C  P. 6 

2/15 

BYTES 

ARE  = 

JP 

M,  CP.  4 

2/1  5 

X  >Y 

LD 

A,  0 

2/15 

C  P 

1 

2/1  5 

JP 

CPN.  1  0 

2/15 

LD 

A,  1 

2/1  5 

CP 

0 

2/15 

JP 

C  PN  .  1 0 

2/1  5 

CP. 5:  LD  A, (IX) 

CP  (IY) 

JP  NZ.CPN.10 
CP. 6:  INC  IX 

INC  IY 
JP  CPN.  1 

CPN.  2: 

{WHL  PARTS  IDENTICAL,  COMPARE  DEC  PARTS 


LD 

A,  L 

CP 

H 

LD 

C,  H 

JP 

P,  CPN.  3 

LD 

C,  L 

DEC 

C 

JP 

M  ,  C  PN  .  4 

LD 

A, (XX+TYP) 

2/1  5 

CP 

NEGFXP 

2/15 

JP 

NZ , CP. 8 

2/1  5 

LD 

A,  (IX) 

2/15 

CP 

(IY) 

2/1  5 

JP 

Z,CP.  9 

2/15 

JP 

M,  CP.  7 

2/1  5 

C  P.  7 


JP 

CPN.  10 

C  P.  7: 

LD 

A,  1 

CP 

0 

JP 

C  PN .  10 

CP.  8: 

LD  A, (IX) 

CP  (IY) 

JP  NZ.CPN.10 

CP.  9: 

INC  IX 

INC  IY 

JP  C  PN. 

3 

C  PN  .  4  s 

LD 

A,  (XX+TYP) 

CP 

NEGFXP 

JP 

NZ  ,  CP,  1  1 

LD 

A,  L 

CP 

H 

JP 

M,  C  P.  1  0 

LD 

A,  0 

CP 

1 

JP 

C  PN  .  1 0 

CP.  1  0: 

LD 

A,  1 

CP 

0 

JP 

CPN.  1  0 

CP.  11: 

LD 

A,  L 

CP 

H 

C  PN  .  1 0 : 

CALL  RSTREG 

• 

t 

RET 

t  t  t  f  t  9  9 

>»»»»»»» 

M  M  H  M  fM 

CM  PS  YM : 

;0B  JECTS  ARE  SYMBOL’S 

;C  OM  PARE  LENGTHS  FIRST,  THEN  EACH  ITEM 
CALL  SAVREG 
LD  H  L  ,  ( XX  +S  PC  ) 

LD  BC,  (  Y  Y+S  PC  ) 

AND  0 
SBC  HL , BC 
JP  NZ.CPS.IO 
;M  OVE  IX,  IY  UP  TO  DATA 
LD  I  X , ( FST  +XX ) 

LD  I Y , ( FST+Y  Y  ) 

C  PS.  1 :  DEC  C 

JP  P ,  C  PS  .  2 
DEC  B 

JP  M,  CPS.  3 

LD  A, ( I  X) 

CP  (IY) 

JP  NZ , CPS.  10 
INC  IX 
INC  IY 
JP  C  PS.  1 


C  PS.  2 


C  PS.  1 0:  CALL  RSTREG 
RET 


CMPSEQ: 

;C  OM  PA  RE  EACH  OBJECT  IN  2  SEQNC'S 
CALL  SAVREG 

;F  IR  ST  COMPARE  THEIR  LENGTHS 
LD  H  L  ,  ( XX  +S  PC  ) 

LD  BC , (  Y  Y+S  PC ) 

AND  0 
SBC  HL , BC 
JP  NZ.CPQ.10 

;M  UST  COMPARE  PAIRS  OF  OBJECTS 
;SET  UP  LOOP  TO  STEP  THROUGH  SEQNC'S 
S  R  A  B 
RR  C 

LD  IX,  (XX+FST) 

LD  I Y , ( YY  +FST ) 

CPQ.  1:  DEC  C 

JP  P, CPQ. 2 
DEC  B 

JP  M, CPQ. 3 
CPQ.  2:  PUSH  BC 
;F  ETC  H  1  OBJ  FROM  X,  Y  EACH 
LD  L, (IX ) 

LD  H  ,  ( I  X  +  1  ) 

LD  ( IDX  +H  DR ) , HL 
CALL  FETCH 
LD  HL.IDX+HDR 
LD  DE , XX 
LD  BC,  1  1 
LDIR 

LD  L , ( I Y ) 

LD  H,  (IY+1  ) 

LD  (IDX+HDR  )  ,HL 
CALL  FETCH 
LD  HL,  IDX+HDR 
LD  DE, YY 
LD  BC,  1 1 
LDIR 

;CALL  COMPAR 

CALL  COMPAR 
LD  BC, 2 
ADD  IX, BC 
ADD  IY.BC 
POP  BC 

JP  NZ , CPQ.  10 
JP  CPQ.1 
CPQ.  3:  CP  A 
CPQ.  10: 


CALL  RSTREG 


;  5  AUG  83  -  ORIGINAL 
;  10  OCT  83  -  REMOVED  SYNTAX  ERRORS 
;  18  NOV  83  -  MODIFIED  COLECT 
;  23  NOV  83  -  ADDED  BCCHECK 
;  29  NOV  83  -  MODIFIED  GC 

{  12  JAN  84  -  REMOVED  UNNECESSARY  PRINT  STATEMENTS 

t 

TITLE  STOR  A/O  12  JAN  84 

GLOBAL  ALLOC , FETCH 

GLOBAL  GETNOD 

GLOBAL  SLIDE , COLECT 

EXTERNAL  PR  LI N E, SA VRE G, RSTRE G 

EXTERNAL  HDR  ,  PTR,  INHSTK,  NODLST,  NODES 

. XL  IS  T 
MACLIB  EQATMO 
EQUATES 

.  LIST 

FAIL  EQU  0 

SUCC  EQU  1 


*>>>>>*»*»»»»*»*»>>*>*>>>>>>»»> 

FETCH: 

CALL  SAVREG 

{LOOK  UP  A  DDR  OF  NODE  WITH  INDEX  (IDX+HDR) 
CALL  GETADR 
JP  Z.FET.8 
;IX  =  A  DDR  OF  NODE 

LD  I X,  (  ADR  +H  DR  ) 

;  GET  NODE  TYPE 

LD  A,  ( I  X+TYP) 

LD  (T  YP  +H  DR  )  ,  A 
{COMPUTE  LAST  A  DDR 

LD  E  ,  ( I X  +N  XT  ) 

LD  D,  ( I  X+1  +N  XT  ) 

LD  H  L  ,  (  A  DR  +H  DR  ) 

ADD  HL,  DE 

;FOL  =  A  DDR  OF  FOLLOWING  NODE 
LD  ( FOL+H  DR ) , HL 
DEC  HL 

LD  (LST+H  DR  )  f  HL 
{COMPUTE  NODE'S  DATA  SPACE 
EX  DE,  HL 
LD  DE,  5 
AND  0 
SBC  HL, DE 
LD  (S  PC  +H  DR  )  ,  H  L 
{COMPUTE  FIRST  A  DDR 
ADD  IX, DE 
LD  (FST+HDR),IX 


CALL  RSTREG 
RET 

FET.  8:  LD  HL,  TYP+HDR 
LD  ( HL )  ,  0 
LD  BC, 8 
LD  DE,  TYP+HDR 
INC  DE 
LDIR 

CALL  RSTREG 
RET 


I  »  I  1  I  I  (  I  I  I  (  I  I  <  )  I  I  (  *  I  I  I  M  M  I  t  I  t  I  I 

ALLOC:  {ALLOCATES  STORAGE  SPACE  TO  NODE(IDX) 

CALL  SAVREG 

9 

A  LC  .  1 : 

LD  HL ,  (  S  PC  +H  DR  )  {TOTAL  LENGTH 
LD  BC,  5  ;  =S  PC  +  5 

ADD  HL ,  BC 

LD  BC,  (  FREE+PTR  ){  ADD  LENGTH 
ADD  H  L , BC  {TO  FREE  TO  SEE 

AND  0  {IF  ENOUGH  STORAGE 

LD  BC  ,  (LAST  +  PTR  )  {SPACE  LEFT 
SBC  HL ,  BC  ;FREE+SPC-LAST>0? 

JP  M.ALC.2  {IF  NOT,  ENOUGH  SPACE 

;IF  NOT  ENOUGH  SPACE,  COLECT  GARBAGE 
LD  HL.IDX+HDR 
LD  DE.SAVNEW 
LD  BC, 5 
LDIR 

CALL  COLECT 
LD  HL.SAVNEW 
LD  DE,  IDX+HDR 
LD  BC, 5 
LDIR 

LD  A,  (GCSUCC)  {TEST  GC  FLAG 

CP  SUCC  {IF  SUCC 

JP  Z.ALC.1  {TEST  FREE  SPACE  AGAIN 

LD  DE, $A  LC .  1 

CALL  PR  LINE 

CALL  RSTREG 

RET 

ALC.  2: 

{SET  IX  TO  POINTER  INTO  NODE  LIST 
CALL  LOOKUP 

LD  HL,  (  FREE+PTR  ){HL  =  1ST  ADR  OF  Ni-DE 
LD  (IX) , L  {STORE  FREE  IN 

LD  ( I  X  + 1  )  ,  H  {IN  LODLST  (NODE  ) 

{HL  =NODE  A  D DR 

LD  (  ADR  +H  DR  )  ,  HL 
{STORE  NODE'S  IDX  AND  TYP 


LD  I  X  ,  (  A  DR  +H  DR  ) 

LD  DE  f ( I DX+H  DR  ) 

LD  (IX+IDX)  ,E 
LD  (IX  +  1+IDX),D 
LD  A , (T YP  +H DR ) 

LD  (IX+TYP)  ,A 

{ADD  5  TO  S PC  TO  GET  N XT 
LD  BC, 5 

LD  DE  ,  (  S  PC  +H  DR  ) 

LD  H L,  0 
ADD  HL ,  BC 
ADD  HL.DE 
LD  ( I  X+N  XT  )  ,  L 
LD  ( I X  +1  +N  XT )  ,  H 

{STORE  F  ST ,  LST,  FOL  IN  HDR  BLCK 
ADD  IX, BC 
LD  ( FST+H  DR )  ,  I X 
ADD  IX, DE 
LD  ( FOL+H  DR  )  ,  I X 
DEC  IX 

LD  (LST+HDR  )  ,IX 

{UPDATE  (FREE) 

LD  BC, ( FREE+PTR  ) 

ADD  HL.BC 
LD  (FREE+PTR ) , HL 
CALL  RSTREG 
RET 

$ALC.1:  DB  'NOT  ENOUGH  FREE  SPACE  $' 


f»»»99f»r»»»999»»9»»f»999999»»99 

| 

GETADR  : 

{LOOKS  UP  A  DDR  OF  NODE  WITH  INDEX  IDX 
{STORES  NODE  A  DDR  IN  ( A  DR +H DR ) 

CALL  SAVREG 
CALL  LOOKUP 
LD  L , ( I  X ) 

LD  H  ,  ( I X  +1  ) 

LD  (  ADR  +H  DR  )  ,  HL 
OR  0 
LD  BC, 0 
SBC  H  L, BC 
CALL  RSTREG 
RET 


{ROUTINES  TO  GET  AND  PUT  NODE  INDICES 

i 

GETNOD: 

CALL  SAVREG 

GET. 0: 


LD  I  X, NODLST -4 
LD  HL, 0 
LD  BC.NUMNOD 
LD  DE  ,  4 

GET.  Is 

DEC  C 

JP  NZ.GET.2 
DEC  B 

JP  M  ,  GET.  3 

GET.  2: 

ADD  IX,  DE 
INC  HL 
LD  A, (IX) 

CP  NILIDX 
JP  NZ , GET.  1 
LD  A, (IX  +1  ) 

CP  NILIDX 
JP  NZ, GET.  1 
LD  (IX).TKNIDX 
LD  (IX+1  )  .TKNIDX 
LD  ( I DX+H  DR ) , HL 
CALL  RSTREG 
RET 

GET.  3: 

CALL  COLECT 
LD  A , ( GCS  UCC ) 

CP  SUCC 
JP  Z  ,  GET.  0 
LD  DE  ,  $M  SGT  2 
CALL  PRLINE 
CALL  RSTREG 
RET 

$M SGT  2:  DB  ':  NEED  MORE  NODES!  ' 
DB  ODH,  OA  H  ,  ’  $  ' 


99999999999999999999999999999999 

LOOKUP: 

;LOOKS  UP  NODE  SLOT  IN  NODLST,  IX  PTS  TO  SLOT 
LD  DE , ( IDX  +H DR ) 

LD  IX,  NODLST-4 
ADD  IX, DE 
ADD  IX,  DE 
ADD  I  X,  DE 
ADD  IX,  DE 
RET 


COLECT: 

{ROUTINES  TO  MARK,  RELEASE  AND  COLLECT 
{NODES  WHICH  ARE  NO  LONGER  NEEDED 


CALL  SAVREG 

;  M  AR  K  ALL  NODES  BELOW  TOP  OF  INHSTK  AND  THEIR  CHILDREN 
CALL  MRKSTK 

{RELEASE  ALL  UNMARKED  NODES  IN  NODLST 
CALL  RELEAS 

;LET  GARBAGE  COLLECTOR  COMPACT 
{RELEASED  STORAGE  SPACE 
CALL  GC 
CALL  RSTREG 
RET 


MltltfMMMMIMMItMMMMM 

MRKSTK: 

{MARKS  ALL  NODES  BELOW  TOP,  AND  ALL  CHILDREN 
{FIRST  DEMARK  ALL 

LD  BC,  NUMNOD 
LD  IX, NODLST 
LD  DE , 4 
DEMK.  1:  DEC  C 

JP  NZ  ,  DEMK.  2 
DEC  B 

JP  M,  DEMK.  3 
JP  Z, DEMK. 3 

DEMK.  2: 

LD  (I  X+2  )  ,  0 
ADD  IX, DE 
JP  DEMK.  1 

DEMK.  3: 

LD  A,  1 
LD  (MARK), A 

{STORE  CURRENT  BAS  AT  TOP 
LD  B C , ( BAS  +PTR ) 

LD  IX,  ( TOP+PTR  ) 

LD  (IX), C 
LD  (I X  +  1  )  ,B 
LD  ( H IB AS )  ,  I  X 

{STEP  DOWN  THRU  FRAMES  UNTIL  BTM  OF  INHSTK 
MKST.  1 :  CALL  SHFBAS 
{NOW  (  LOB  AS  )=  BAS  OF  CURRENT  FRAME 
{AND  (NUMAT)  =  #  OF  ATTR.  IN  THE  FRAME 
LD  IX, ( LOB  AS ) 

INC  IX 
INC  IX 

{IX  PTS  TO  FIRST  DATA  BYTE 
LD  BC, (NUMAT) 

CALL  BCNOTZ 
JP  Z, MKST. 2 

{MARK  BC  NODES  IN  CURRENT  FRAME 
CALL  MARKER 


MKST.  2 


LD  H  L , ( LOB AS ) 

LD  (HIBAS).HL 
{COMPARE  IT  TO  INHSTK  B  TM 
LD  DE  ,  INHSTK 
AND  0 
SBC  HL,  DE 
RET  M 

JP  NZ  ,  MKST.  1 
RET 


MARKER: 

{MARKS  BC  NODES,  WITH  FIRST  INDEX 
{POINTED  TO  BY  IX 


MK.  10: 

CALL  BCCHECK 

;  11/23 

JP 

Z,MK.  20 

{  11/23 

DEC 

BC 

;  11/23 

MK.  1  1: 

LD 

E, (IX) 

LD 

D,  ( I X  +  1  ) 

LD 

(IDX+HDR)  ,  DE 

DEC 

DE 

LD 

IY, NODLST 

ADD 

IY,  DE 

ADD 

IY,  DE 

ADD 

I  Y,  DE 

ADD 

IY,  DE 

LD 

A, (MARK  ) 

LD 

( I  Y+2  )  ,  A 

LD 

A  ,  (  I Y  ) 

CP 

TKNIDX 

JP 

NZ , M  K. 2 

LD 

A ,  ( I  Y  +  1  ) 

CP 

TKNIDX 

JP 

Z,  MK.  14 

MK.  2: 

CALL  FETCH 

LD 

A,  (TYP+HDR  ) 

CP 

SEQNC 

JP 

Z  ,  MK.  12 

CP 

STREM 

JP 

NZ , MK.  14 

;  SEQ  OR  STR  FOUND:  MUST  CALL  MARKER  RECURSIVELY 
M  K. 1 2:  CALL  SA VREG 


LD  I  X, ( FST+H  DR  ) 
LD  B C  ,  (S  PC  +H  DR  ) 
CALL  BCNOTZ 
JP  Z,MK.  1  3 
SRL  B 
RR  C 

CALL  MARKER 

MK.  1  3: 

CALL  R STR  EG 
MK.14:  INC  IX 
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INC  IX 
JP  MK.  10 
; A LL  DONE 
MK.  20: 

RET 


SHFBAS: 

{ROUTINE  TO  MAKE  (LOBAS)  PT  TO  NEXT 

;BAS  BELOW  (HIBAS),  ( N  UMAT  )  =  //  OF  INDICES  BETWEEN 
CALL  SAVREG 
LD  HL, (HIBAS) 

LD  E, (HL) 

INC  HL 
LD  D, ( H L ) 

LD  (LOBAS), DE 
DEC  HL 
DEC  HL 
DEC  HL 
AND  0 
SBC  HL,  DE 
SR  L  H 
RR  L 

LD  (N  UM AT ) , HL 
CALL  RSTREG 
RET 


RELEAS: 

{RELEASES  ANY  UNMARKED  NODES  IN 
CALL  SAVREG 
LD  BC,  NUMNOD 
LD  I  X, NODLST 
LD  A, ( MARK) 

LD  D,  A 

RLS.  11:  CALL  BCCHECK 

JP  Z,  RLS.  13 

DEC  BC 

RLS.  1  0: 

LD  A,  (  I X+2  ) 

CP  D 

JP  Z , RLS.  12 
LD  A, N ILIDX 
CP  (IX) 

JP  NZ , R  LS. 15 
CP  (I  X  +  1  ) 

JP  Z,RLS.  12 

R  LS. 1 5: 

LD  L , ( I  X ) 

LD  H  ,  ( I X  +1  ) 

LD  (HL) ,NILIDX 


NODLST, 


11/23  -  ALL  NODES  PROCES 
1  1 /23  -  HERE  IF  YES 
11/23 


- 


•  .•  .sv 

■  »  -  <r. 


INC  HL 

LD  (HL) , NILIDX 
LD  (IX), NILIDX 
LD  (I  X  +  1  )  ,  NILIDX 
RLS.12:  INC  IX 
INC  IX 
INC  IX 
INC  IX 
JP  RLS.  1  1 

RLS.  1  3: 

CALL  RSTREG 
RET 


SLIDE: 

;  R  OUT  I N  E  TO  SLIDE  TOP-MOST  ATTR  FRAME 

;  DOWN  OVER  FRAME  JUST  BELOW  IT 

; R  ES ETS  BAS  AND  TOP 
CALL  SAVREG 

;SET  IX  TO  TOP  AND  STORE  BAS  THERE 
LD  I  X , (TOP  +PTR ) 

LD  BC, ( BAS+PTR ) 

LD  (IX), C 
LD  (I X  +  1  )  ,B 
LD  (HIBAS).IX 

;C  ALL  SHF  BAS  TO  GET  //  OF  BYTES  IN  TOP  FRAME 
CALL  SHFBAS 
LD  BC.(NUMAT) 

SLA  C 
RL  B 

{SHIFT  DOWN  ONE  MORE  FRAME 
LD  H  L , ( LOBAS ) 

LD  (H IB  AS ) , HL 
CALL  SHFBAS 

{SAVE  (LOBAS)  AS  NEW  BAS 
LD  DE, (LOBAS) 

LD  (BAS+PTR), DE 

{POINT  HL.DE  TO  1ST  UPPER, LOWER  DATA  BYTES 
INC  HL 
INC  HL 
INC  DE 
INC  DE 
CALL  BCNOTZ 
JP  Z,SL.  2 

{MOVE  FRAME  DOWN 
LDIR 

SL.  2: 

;DE  IS  NOW  NEW  TOP 

LD  (TOP  +PTR ) , DE 
CALL  RSTREG 


LOBAS:  DW  0 

HIBAS:  DW  0 

NUMAT;  DW  0 


GC  : 

;GA  RB  AGE  COLLECTOR 
CALL  SAVREG 
LD  IX, ( BASE+PTR ) 

;TH IS  LOOP  LOOKS  FOR  FIRST  NIL  NODE 
S IF  FREE  REACHED,  GC  FAILS 
GC. 1 :  CALL  TESTFRE 

JP  P , GC . 9 

;  I F  NIL  NODE  FOUND,  GC  SUCCESSFUL 
CALL  TESTNIL 
JP  Z , GC . 2 
CALL  NEXTIX 
JP  GC.  1 

; SA  VE  COLLECTION  PTR 
GC . 2:  LD  ( COLPTR ) , IX 

;SET  SUCCESS  FLAG 
LD  A, SUCC 
LD  (GCSUCC).A 

;THIS  LOOP  LOOKS  FOR  FIRST  NON-NIL  NODE 
GC.21:  CALL  NEXTIX 

;IF  FREE  FOUND,  QUIT 
CALL  TESTFRE 
JP  P.GC.8 
CALL  TESTNIL 
JP  NZ , GC . 3 
JP  GC.21 

;NON-N  IL  FOUND,  MOVE  IT 
GC.  3: 

;SET  MOVE  PTR 

LD  ( MOVPT  R ) , I X 
{RESET  THE  NODE  »S  A  DDR 
LD  DE, (COLPTR) 

LD  C , (IX  +IDX ) 

LD  B ,  (  I X+I DX  +  1  ) 

LD  I Y, NODLST -4 
ADD  IY.BC 
ADD  I  Y,  BC 
ADD  I Y ,  BC 
ADD  I Y, BC 
LD  ( I Y  )  ,  E 
LD  (I Y  +1 ) , D 
LD  C ,  ( I  X+N  XT  ) 

LD  B,  (IX+NXT+1  ) 

{TEST  THAT  BOO 
LD  A,  0 
CP  C 

JP  M  ,  GC  .  31 


JP  P.GC.91 


GC. 31: 

{MOVE  BC  BYTES  FROM  ’MOV*  TO  'COL' 

LD  HL,(MOVPTR) 

LDIR 

{MOVE  COL  FORWARD 

LD  (  COLPTR  )  ,  DE 

{ GO  BACK  TO  LOOK  FOR  NEXT  NON-NIL 
JP  GC . 21 

{SET  FREE  TO  LAST  (COLPTR) 

GC  .  8:  LD  IX, (COLPTR) 

LD  ( FREE+PTR ) , IX 
JP  GC.  10 

{GC  FAILED,  SEND  A  MSG 

GC.9:  LD  DE,$GC.2 

CALL  PR  LI NE  ;  1/12 

LD  A, FAIL 
LD  (GCSUCC)  ,  A 

GC.  1  0:  CALL  RSTREG  {  1/12 

RET 

GC. 91:  LD  DE, $GC. 91 

CALL  PR  LI  NE  ;  1/12 

JP  GC.10 

f 

$GC.2:  DB  'NO  GARBAGE  FOUND  ' 

DB  ODH, OA  H  ,  ' $  ' 

$GC ,  91  :  DB  '  N  XT  <  =  0:  ERROR!  ' 

DB  ODH, OA  H  ,  '  $  ' 

V 

m  n  m  m  i  i  I  !  $  i  {  i  |  |  |  |  |  }  {  )  {  $  i  j  i  |  j  { 

t 

N  E  XT  I X :  ;BC<NEXT(IX) 

LD  C  ,  ( I X  +N  XT  ) 

LD  B ,  (  I  X+N  XT  +1  ) 

ADD  IX, BC 
RET 

9 

TESTFRE:  {TESTS  IF  IX  =  FREE 

PUSH  IX 

POP  HL  {HLrIX 

LD  DE, (FREE+PTR ) 

AND  0  {CLEAR  CARRY 

SBC  H  L,  DE  {COMPARE  BY  SUBTRACTION 

RET  {TEST  F OF  NZ  UPON  RET 

9 

********•••••••••••••••••••««••• 

•  )>  I  I  M  t  I  I  I  ,  t,  t  ,,,,,,,,,,,,,,,,  , 

9 

TESTNIL:  {TEST  IF  IX  IS  NIL 

LD  A , (IX  +IDX )  {TEST  BOTH  BYTES 
CP  NILIDX  {OF  INDEX(IX) 

RET  NZ 

LD  A ,  ( I  X+I  DX  +  1  )  {AGAINST  NIL 
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CP  NILIDX 

RET  ;  U  PO  N 

BCNOTZ  : 


CALL 

SA  VREG 

LD  HL,  0 

OR  0 

SBC 

HL,  BC 

CALL 

RET 

RSTREG 

BCCHECK: 

XOR 

A 

ADD 

A,  B 

JP 

RET 

Z,  BC  1 

BC  1: 

XOR 

A 

ADD 

A,C 

• 

» 

RET 

• 

MARK: 

DB 

1 

SA  VNEW: 

DS 

2  OH 

COLPTR : 

DW 

0 

MOVPTR: 

DW 

0 

GCSUCC  : 

DW 

END 

0 

;END  OF 

STOR 

I 


;TEST  FOR  NZ 
RETURN 


;  CLEAR  ACCUMULATOR 

;  CHECK  C  REGISTER 
;  ELSE  RETURN 
;  CLEAR  ACCUMULATOR 


7  OCT  83 


;  ALL  OF  THE  MACROS  FOR  ZBADJR  ARE  IN  THIS  FILE 

; THE  FRAME  HANDLING  FUNCTIONS... 

;SET  A  NEW  BAS,  OBAS 
SETINH  MACRO 

CALL  SETINH 

EN  DM 

;STACK  LIST  OF  aTTRS.  ONTO  CURRENT  FRAME 
STKINH  MACRO  VAR 

IRP  P ,  <  V  A  R  > 

LD  B C , P 
CALL  STKINH 

EN  DM 

EN  DM 

{SHORTHAND  FOR  SETINH , STKI NH 
INHER  MACRO  VAR 

CALL  SETINH 
STKINH  < VAR  > 

EN  DM 

• 

•SHORTHAND  FOR  CALL  RSTINH 
DISINH  MACRO 

CALL  RSTINH 

EN  DM 

{RESET  BAS,  OBAS  TO  PREVIOUS  VALUES 
RSTINH  MACRO 

CALL  RSTINH 

EN  DM 

SETBAS  MACRO 

CALL  SETBAS 

EN  DM 

• 

R  STB  AS  MACRO 

CALL  R  STB  AS 

EN  DM 

• 

{DEFINE  A  LIST  OF  LOCAL  ATTRIBUTES 
DEFLOC  MACRO  VAR 

IR  P  P, <VAR> 

CALL  DEFLOC 

EN  DM 

EN  DM 

t 

QUES  MACRO  B , NXTA  LT 

INHER  < B  > 

LD  HL,  NXTALT 


EN  DM 


CALL  QUES 


MACRO  ENDLINE 
JP  ENDLINE 


MACRO 

CALL  SLIDE 


ENDALT 
EN  DM 
SLIDE 
EN  DM 
BAND 


EN  DM 
BOR 


EN  DM 
BXOR 


EN  DM 

t 

B  NOT 


EN  DM 
ATOM? 


EN  DM 
NIL? 


EN  DM 
SYMBOL? 


MACRO 

INHER 

CALL 

DISINH 


MACRO 

INHER 

CALL 

DISINH 


MACRO 

INHER 

CALL 

DISINH 


MACRO 

INHER 

CALL 

DISINH 


MACRO 

INHER 

CALL 

DISINH 


VAR 
< VAR  > 
BAND 


VAR 
<  VAR  > 
BOR 


VAR 
<  VAR  > 
ATOM? 


VAR 
<  VAR  > 
NIL? 


VAR 
<  VAR  > 
SYMBOL? 


MACRO  VAR 
INHER  < VAR  > 
CALL  BXOR 
DISINH 


MACRO  VAR 
INHER  < VAR  > 
CALL  B NOT 
DISINH 


INHER  <V  A  R  > 

CALL  NUMBER? 
DISINH 

EN  DM 

BOOLEAN?  MACRO  VAR 

INHER  < VAR  > 

CALL  BOOLEAN? 
DISINH 

EN  DM 

EMPTY?  MACRO  VAR 
INHER  < VAR  > 

CALL  EMPTY? 

DISINH 

EN  DM 

SEQUENCE?  MACRO  VAR 

INHER  < VAR  > 

CALL  SEQUENCE? 
DISINH 

EN  DM 

FINITE?  MACRO  VAR 
INHER  < VAR  > 

CALL  FINITE? 
DISINH 

EN  DM 

STREAM?  MACRO  VAR 
INHER  < VAR  > 

CALL  STREAM? 
DISINH 

EN  DM 

• 

DRY?  MACRO  VAR 
INHER  < VAR  > 

CALL  DRY? 

DISINH 

EN  DM 


NUM  MACRO  X 

;  M  A  C  R  0  FOR  IMMEDIATE  NUMERIC  CONSTANT  FUNCTION 
;F OR  EXAMPLE:  "NUM  <’  +12.34»>"  MAKES  A 
{NUMBER  NODE  AND  PUSHES  ITS  INDEX  ONTO  THE 
{INHERITED  ATTRIBUTE  STACK 
LOCAL  EN 
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EN: 

CALL  NUMIMM 

EN  DM 

SYM 

MACRO  X 

{MACRO  FOR  IMMEDIATE  STRING  FUNCTION 

;F OR  EXAMPLE:  "SYM  <'ABCD»>"  CREATES  A  SYMBL 

; NODE  AND  PUSHES  ITS  INDEX  ONTO  THE 

INHERITED  ATTRIBUTE  STACK 
LOCAL  ES 
JP  ES 
DB  •//• 

DB  X 

ES: 

CALL  SYMIMM 

EN  DM 

» 

SL  MACRO  X,  I 

; DOES  SELECT  OF  I'TH  ELEMENT  OF  SEQNC  X 
STKINH  X 
LD  BC,  I 
CALL  SELIMM 

EN  DM 

• 

SR  MACRO  X, I 

{DOES  SER  OF  I»TH  ELEMENT  FROM  END  OF  X 
STKINH  X 
LD  BC,  I 
CALL  SERIMM 

EN  DM 

CONS  MACRO 

CALL  SETINH 

EN  DM 

CLSCON  MACRO 

CALL  CONIMM 

EN  DM 

i 

CONCAT  MACRO 

CALL  SETINH 

EN  DM 

CLSCAT  MACRO 

CALL  CATIMM 

EN  DM 

I 

HEAD  MACRO  X 

STKINH  <X> 

CALL  HEAD 

EN  DM 

TAIL  MACRO  X 


STKINH  <X> 

CALL  TAIL 

EN  DM 

MERGE  MACRO 

;MERGES  SEQNC  *  S  X,  ,  ,  Y  INTO  SEQNC  Z 
SETINH 

EN  DM 

» 

CLSMER  MACRO 

CALL  MERIMM 

EN  DM 

« 

ID  MACRO  VAR 

INHER  < VAR  > 

CALL  ID 
DISINH 

EN  DM 

SEQSTR  MACRO  VAR 
INHER  < VAR  > 

CALL  SEQSTR 
DISINH 

EN  DM 

STRSEQ  MACRO  VAR 

INHER  < VAR  > 

CALL  STRSEQ 
DISINH 

EN  DM 

» 

SYMSEQ  MACRO  VAR 

INHER  < VAR  > 

CALL  SYMSEQ 
DISINH 

EN  DM 

I 

SEQSYM  MACRO  VAR 

INHER  < VAR  > 

CALL  SEQSYM 
DISINH 

EN  DM 


SEQNUM  MACRO  VAR 

INHER  < VA R  > 
CALL  SEQNUM 
DISINH 

EN  DM 

NUMSYM  MACRO  VAR 

INHER  < VA R  > 
CALL  NUMSYM 
DISINH 


RV  MACRO  VAR 

INHER  <  VAR  > 

CALL  RV 
DISINH 

EN  DM 

DL  MACRO  VAR 

INHER  < VAR  > 

CALL  DL 
DISINH 

EN  DM 

DR  MACRO  VAR 

INHER  < VAR  > 

CALL  DR 
DISINH 

EN  DM 

9 

SEL  MACRO  VAR 

INHER  < VAR  > 

CALL  SEL 
DISINH 

EN  DM 

SER  MACRO  VAR 

INHER  < VAR  > 

CALL  SER 
DISINH 

EN  DM 

9 

TR  MACRO  VAR 

INHER  < VAR  > 

CALL  TR 
DISINH 

EN  DM 

;  M  AC  ROS  FOR  RELATIONAL  FUNCTIONS 

EQ?  MACRO  X 

INHER  <X> 

CALL  EQ 
DISINH 

EN  DM 

NE?  MACRO  X 

INHER  <X> 

CALL  NE 
DISINH 

EN  DM 

LT?  MACRO  X 


l'  o  C  O  *.7.  ■- 


INHER  <X> 
CALL  LT 
DISINH 


MACRO  X 
INHER  <X> 
CALL  LE 
DISINH 


MACRO  X 
INHER  <X> 
CALL  GT 
DISINH 


MACRO  X 
INHER  <X> 
CALL  GE 
DISINH 


MACRO  X 
INHER  <X> 
CALL  AD 
DISINH 


MACRO  X 
INHER  <X> 
CALL  SB 
DISINH 


MACRO  X 
INHER  <X> 
CALL  ML 
DISINH 


MACRO  X 
INHER  <X> 
CALL  DV 
DISINH 


MACRO  X 
INHER  <X> 
CALL  AB 
DISINH 


NG 


EN  DM 
INT 


EN  DM 
MD 


EN  DM 

9 

RDNUM 


EN  DM 
PRNUM 


EN  DM 
R  DS  YM 


EN  DM 
PRSYM 

EN  DM 

9 

» 

RDBUL 


MACRO  X 
INHER  <X> 
CALL  NG 
DISINH 


MACRO  X 
INHER  <X> 
CALL  INT 
DISINH 


MACRO  X,  M ,  Z 
INHER  < X, M , Z  > 
DEF  LOC  <4  ,  5,  6 
INT  < 2, 4  > 

DV  <1  ,  4,  5> 
INT  < 5, 6  > 

ML  <4,  6,  7> 

SB  <1, 7,3> 
RSTINH 


MACRO  X 
INHER  <X> 
CALL  RDNUM 
DISINH 


MACRO  X 
INHER  <X> 
CALL  PRNUM 
DISINH 


MACRO  X 
INHER  <X> 
CALL  R  DS  YM 
DISINH 


MACRO  X 
INHER  <X> 
CALL  PRSYM 
DISINH 


MACRO  X 
INHER  <X> 
CALL  RDBUL 
DISINH 


,  7> 


EN  DM 


PRBUL 


MACRO  X 
INHER  <X> 

CALL  PRBUL 
DISINH 

EN  DM 

{MACROS  FOR  W HILE , A  PPL Y -T O-A LL ,  INS ER T 

WHILE  MACRO  XZ  R , F  N , ATR 

SETINH 

STKI  NH  <XZ  R  > 

CALL  WHILE1 
STKWLD  <ATR> 

LD  HL,FN 
CALL  WHILE  2 
RSTINH 

EN  DM 

APPLYTOALL  MACRO  XZ.FN.ATR 

SETINH 
STKI  NH  <XZ  > 

CALL  A P PLY  1 
STKWLD  <ATR> 

LD  HL,FN 
CALL  A  PPL Y  2 


RSTINH 

EN 

DM 

STKW 

LD 

MACRO 

VAR 

IRP  P, 

<  VAR  > 

LD  BC, 

P 

CALL  STKWLD 

ENDM 

EN 

DM 

INSERT 

MACRO 

ATR 

INHER 

<ATR  > 

LD  HL, 

FN 

CALL  I 

NSERT 

DISINH 

EN  DM 

{DISK  AND  CONSOLE  10 
RDCON  MACRO 
LD  A,  0 
CALL  IOSEL 

EN  DM 

WRCON  MACRO 
LD  A,  1 
CALL  IOSEL 

EN  DM 

R  DO  PE N  MACRO 


FLNAME 
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MACROS  TO  DEFINE  OFFSETS 
7  OCT  83 

21  DEC  83  -  MODIFIED  BOOLEAN,  TRUE,  AND  FALSE 


EQUATES 


MACRO 

NSTANTS 

NIL 

EQU 

OA  OH 

NUMBR 

EQU 

OC  OH 

NEGFXP 

EQU 

OC  1H 

POSFXP 

EQU 

0C2H 

F  IXPT 

EQU 

OC  3H 

NEGFLP 

EQU 

OC  8H 

POSFLP 

EQU 

OC  9H 

SYMBL 

EQU 

OD  OH 

BOOLN 

EQU 

OD  OH 

ATOM 

EQU 

ODFH 

SEQNC 

EQU 

OE  OH 

NULL 

EQU 

OE  1 H 

STREM 

EQU 

OF  OH 

DRY 

EQU 

OF  1 H 

;  PTR  DISPLACEMENTS 

BASE  EQU  0 

FREE  EQU  2 

LAST  EQU  4 

FLGC  EQU  6 

COL  EQU  8 

MOV  EQU  10 

OBAS  EQU  12 

BAS  EQU  14 

TOP  EQU  16 

CONS  EQU  18 

LAS  EQU  20 

{ATTRIBUTE  PASSING  PARAMETERS 
NINH  EQU  0  ;  If  OF 

NS YN  EQU  2  ; #  OF 

DESC  EQU  4  ; B  LK 

BLKSIZ  EQU  16  ;SIZE 

•  H  DR  DISPLACEMENTS 


»  OF  INH  ATTR 
#  OF  SYN  ATTR 
B  LK  FOR  DESCRIPTORS 
SIZE  OF  DESC  BLKS 


{OTHER 


I D  X 

EQU 

0 

TYP 

EQU 

IDX+2 

N  XT 

EQU 

TYP  +1 

SPC 

EQU 

TYP  +  1 

NODE 

PARAMETERS 

ADR 

EQU 

SPC +2 

FST 

EQU 

A  DR +2 

LST 

EQU 

FST+2 

FOL 

EQU 

LST  +2 

GENERAL  CONSTANTS 
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